spacewalk-commits October 2011

spacewalk-commits@lists.fedorahosted.org

9 participants
236 discussions

Changes to 'refs/tags/rhnlib-2.5.47-1'
by Jan Pazdziora 28 Oct '11

28 Oct '11

Tag 'rhnlib-2.5.47-1' created by Jan Pazdziora <jpazdziora(a)redhat.com> at 2011-10-28 10:16 +0000 Tagging package [rhnlib] version [2.5.47-1] in directory [client/rhel/rhnlib/]. Changes since rhn-virtualization-5.4.29-1: Jan Pazdziora (3): 600527 - for kickstart session (re)activation keys, always set the deployConfigs to false. 600527 - during kickstart, check if at least one activation key allows config files to be deployed upon registration. Automatic commit of package [rhnlib] release [2.5.47-1]. --- backend/server/rhnServer/server_kickstart.py | 14 ++++++++++ client/rhel/rhnlib/rhnlib.spec | 6 +++- java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java | 11 ------- java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java | 5 +-- rel-eng/packages/rhnlib | 2 - 5 files changed, 23 insertions(+), 15 deletions(-) ---

1 0

client/rhel rel-eng/packages
by Jan Pazdziora 28 Oct '11

28 Oct '11

client/rhel/rhnlib/rhnlib.spec | 6 +++++- rel-eng/packages/rhnlib | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) New commits: commit df365d76aeaa06221121c8437e32566168e7b6c2 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Fri Oct 28 12:16:14 2011 +0200 Automatic commit of package [rhnlib] release [2.5.47-1]. diff --git a/client/rhel/rhnlib/rhnlib.spec b/client/rhel/rhnlib/rhnlib.spec index 327d119..12db525 100644 --- a/client/rhel/rhnlib/rhnlib.spec +++ b/client/rhel/rhnlib/rhnlib.spec @@ -4,7 +4,7 @@ Summary: Python libraries for the RHN project Name: rhnlib URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz -Version: 2.5.46 +Version: 2.5.47 Release: 1%{?dist} Group: Development/Libraries @@ -61,6 +61,10 @@ rm -rf $RPM_BUILD_ROOT %{python_sitelib}/* %changelog +* Fri Oct 28 2011 Jan Pazdziora 2.5.47-1 +- Do not rely on exact amount of memomory when determinig PASS/FAIL + (jhutar(a)redhat.com) + * Mon Oct 24 2011 Martin Minar <mminar(a)redhat.com> 2.5.46-1 - simplify code (msuchy(a)redhat.com) - move imports to beginning of file (msuchy(a)redhat.com) diff --git a/rel-eng/packages/rhnlib b/rel-eng/packages/rhnlib index a7aed51..9816c82 100644 --- a/rel-eng/packages/rhnlib +++ b/rel-eng/packages/rhnlib @@ -1 +1 @@ -2.5.46-1 client/rhel/rhnlib/ +2.5.47-1 client/rhel/rhnlib/

1 0

2 commits - backend/server java/code
by Jan Pazdziora 28 Oct '11

28 Oct '11

backend/server/rhnServer/server_kickstart.py | 14 ++++++++++ java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java | 11 ------- java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java | 5 +-- 3 files changed, 17 insertions(+), 13 deletions(-) New commits: commit 197126b6b6aaeac65c51253523a5180d08361e9d Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Thu Oct 27 14:07:42 2011 +0200 600527 - during kickstart, check if at least one activation key allows config files to be deployed upon registration. diff --git a/backend/server/rhnServer/server_kickstart.py b/backend/server/rhnServer/server_kickstart.py index 91be103..b878032 100644 --- a/backend/server/rhnServer/server_kickstart.py +++ b/backend/server/rhnServer/server_kickstart.py @@ -349,6 +349,20 @@ def schedule_config_deploy(server_id, action_id, kickstart_session_id, else: aid = action_id + tokens_obj = rhnFlags.get("registration_token") + if not tokens_obj: + log_debug(3, "Failed to get the registration_token") + return aid + else: + tokens_obj = rhnFlags.get("registration_token") + deployment = false + for token in tokens_obj.tokens: + if token['deploy_configs'] == 'Y': + deployment = true + break + if not deployment: + return aid + next_action_id = rhnAction.schedule_server_action( server_id, action_type='configfiles.deploy', commit 0e4e633f225466f45cb48d2d6db3458c135d1c76 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 16:55:58 2011 +0200 600527 - for kickstart session (re)activation keys, always set the deployConfigs to false. After a change for bug 557581, only one activation key with rhnregtoken.deploy_configs set to Y is enough for configuration to start deploying. We need to give the user a chance to check the Configuration File Deployment in user activation key explicitly. diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java index 4278e89..5ccd2ab 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartScheduleCommand.java @@ -684,12 +684,6 @@ public class KickstartScheduleCommand extends BaseSystemOperation { note = "Automatically generated activation key."; } - boolean cfgMgmtFlag = - this.getKsdata() - .getKickstartDefaults() - .getCfgManagementFlag() - .booleanValue(); - RegistrationType regType = getKsdata().getRegistrationType(user); if (regType.equals(RegistrationType.REACTIVATION)) { @@ -698,7 +692,6 @@ public class KickstartScheduleCommand extends BaseSystemOperation { this.ksdata, RegistrationType.REACTIVATION.equals(regType) ? getTargetServer() : null, this.kickstartSession, - cfgMgmtFlag, 1L, note); } @@ -853,7 +846,6 @@ public class KickstartScheduleCommand extends BaseSystemOperation { * @param ksdata associated with the key * @param server being kickstarted (can be null) * @param session associated with the kickstart (NOT NULL) - * @param deployConfigs if you want to or not * @param note to add to key * @param usageLimit to apply to the key. null for unlimited. * @return ActivationKey that has been saved to the DB. @@ -862,7 +854,6 @@ public class KickstartScheduleCommand extends BaseSystemOperation { KickstartData ksdata, Server server, KickstartSession session, - boolean deployConfigs, Long usageLimit, String note) { @@ -870,7 +861,7 @@ public class KickstartScheduleCommand extends BaseSystemOperation { ActivationKey key = ActivationKeyManager.getInstance(). createNewReActivationKey(creator, server, note, session); key.addEntitlement(ServerConstants.getServerGroupTypeProvisioningEntitled()); - key.setDeployConfigs(deployConfigs); + key.setDeployConfigs(false); key.setUsageLimit(usageLimit); if (KickstartVirtualizationType.paraHost(). equals(ksdata.getKickstartDefaults().getVirtualizationType())) { diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java index 7b0e909..22022a5 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java @@ -27,7 +27,6 @@ import com.redhat.rhn.domain.user.User; import com.redhat.rhn.domain.user.UserFactory; import com.redhat.rhn.manager.profile.ProfileManager; -import org.apache.commons.lang.BooleanUtils; import org.apache.log4j.Logger; import java.util.Date; @@ -94,8 +93,8 @@ public class KickstartSessionCreateCommand { log.debug("creating one-time-activation key: " + user.getLogin()); ActivationKey key = KickstartScheduleCommand.createKickstartActivationKey(user, ksdata, null, - this.ksession, BooleanUtils.toBoolean( - ksdata.getKickstartDefaults().getCfgManagementFlag()), null, note); + this.ksession, + null, note); log.debug("added key: " + key.getKey()); // Need to add child channels to the key so when kickstarting the

1 0

Branch 'ipv6' - 99 commits - backend/satellite_tools backend/server backend/spacewalk-backend.spec client/rhel client/tools java/buildconf java/code java/conf java/spacewalk-java.spec monitoring/PerlModules proxy/installer proxy/proxy rel-eng/packages rel-eng/releasers.conf search-server/spacewalk-search spacecmd/spacecmd.spec spacecmd/src spacewalk/spacewalk-setup-jabberd
by Milan Zazrivec 27 Oct '11

27 Oct '11

backend/satellite_tools/satsync.py | 24 backend/server/rhnServer/server_hardware.py | 2 backend/spacewalk-backend.spec | 5 client/rhel/rhn-client-tools/rhn-client-tools.spec | 10 client/rhel/rhn-client-tools/src/bin/rhnreg_ks.py | 9 client/rhel/rhn-client-tools/src/up2date_client/hardware.py | 2 client/rhel/rhn-client-tools/src/up2date_client/hardware_hal.py | 4 client/rhel/rhnlib/rhnlib.spec | 6 client/rhel/rhnlib/test/24-ssl-memleak.py | 16 client/rhel/yum-rhn-plugin/actions/packages.py | 10 client/rhel/yum-rhn-plugin/yum-rhn-plugin.spec | 6 client/tools/osad/osad.spec | 5 client/tools/osad/src/osad.py | 2 client/tools/rhn-virtualization/rhn-virtualization.spec | 11 client/tools/rhn-virtualization/virtualization/domain_control.py | 2 client/tools/rhn-virtualization/virtualization/domain_directory.py | 2 client/tools/rhn-virtualization/virtualization/poller.py | 6 client/tools/rhn-virtualization/virtualization/support.py | 4 client/tools/rhncfg/actions/configfiles.py | 11 client/tools/rhncfg/rhncfg.spec | 6 dev/null |binary java/buildconf/build-props.xml | 2 java/buildconf/build-taskdefs.xml | 2 java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml | 2 java/code/src/com/redhat/rhn/common/hibernate/ConnectionManager.java | 2 java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java | 28 java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml | 6 java/code/src/com/redhat/rhn/domain/kickstart/KickstartData.java | 6 java/code/src/com/redhat/rhn/domain/server/Device.java | 1 java/code/src/com/redhat/rhn/frontend/action/channel/manage/RepositoriesAction.java | 2 java/code/src/com/redhat/rhn/frontend/strings/java/StringResource_en_US.xml | 7 java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java | 125 java/code/src/com/redhat/rhn/frontend/xmlrpc/configchannel/ConfigChannelHandler.java | 6 java/code/src/com/redhat/rhn/frontend/xmlrpc/system/SystemHandler.java | 6 java/code/src/com/redhat/rhn/frontend/xmlrpc/system/provisioning/snapshot/SnapshotHandler.java | 3 java/code/src/com/redhat/rhn/manager/channel/repo/BaseRepoCommand.java | 2 java/code/src/com/redhat/rhn/manager/kickstart/KickstartCloneCommand.java | 2 java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java | 6 java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java | 2 java/code/src/com/redhat/rhn/taskomatic/TaskomaticApi.java | 9 java/code/webapp/WEB-INF/pages/systems/sdc/hardware.jsp | 2 java/code/webapp/WEB-INF/pages/systems/systemsearch.jsp | 2 java/conf/rhn.xml | 3 java/conf/rhn6.xml | 22 java/spacewalk-java.spec | 35 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/BUILD | 53 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.c | 117 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.pm | 207 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.xs | 79 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/COPYRIGHT | 67 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Changes | 48 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/MANIFEST | 11 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile | 759 --- monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile.PL | 13 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/README | 173 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/_blowfish.c | 478 -- monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/Blowfish.pm | 207 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/Crypt::Blowfish.3 | 330 - monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blowfish.h | 6 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/files.txt | 4 monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/test.pl | 281 - monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/typemap | 1 monitoring/PerlModules/CPAN/Crypt-DES-2.03/BUILD | 52 monitoring/PerlModules/CPAN/Crypt-DES-2.03/COPYRIGHT | 50 monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.pm | 172 monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.xs | 90 monitoring/PerlModules/CPAN/Crypt-DES-2.03/MANIFEST | 10 monitoring/PerlModules/CPAN/Crypt-DES-2.03/Makefile.PL | 16 monitoring/PerlModules/CPAN/Crypt-DES-2.03/README | 83 monitoring/PerlModules/CPAN/Crypt-DES-2.03/_des.c | 591 -- monitoring/PerlModules/CPAN/Crypt-DES-2.03/des.h | 7 monitoring/PerlModules/CPAN/Crypt-DES-2.03/test.pl | 370 - monitoring/PerlModules/CPAN/Crypt-DES-2.03/typemap | 1 monitoring/PerlModules/CPAN/DBD-Pg-0.95/BUILD | 47 monitoring/PerlModules/CPAN/DBD-Pg-0.95/Changes | 238 - monitoring/PerlModules/CPAN/DBD-Pg-0.95/MANIFEST | 13 monitoring/PerlModules/CPAN/DBD-Pg-0.95/Makefile.PL | 63 monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.h | 46 monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.pm | 1162 ----- monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.xs | 592 -- monitoring/PerlModules/CPAN/DBD-Pg-0.95/README | 158 monitoring/PerlModules/CPAN/DBD-Pg-0.95/README.win32 | 75 monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbd-pg.pod | 411 - monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.c | 1725 ------- monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.h | 73 monitoring/PerlModules/CPAN/DBD-Pg-0.95/eg/ApacheDBI.pl | 70 monitoring/PerlModules/CPAN/DBD-Pg-0.95/test.pl | 462 -- monitoring/PerlModules/CPAN/Error-0.15/BUILD | 44 monitoring/PerlModules/CPAN/Error-0.15/ChangeLog | 73 monitoring/PerlModules/CPAN/Error-0.15/Error.pm | 750 --- monitoring/PerlModules/CPAN/Error-0.15/Error.ppd | 10 monitoring/PerlModules/CPAN/Error-0.15/MANIFEST | 9 monitoring/PerlModules/CPAN/Error-0.15/Makefile.PL | 29 monitoring/PerlModules/CPAN/Error-0.15/README | 91 monitoring/PerlModules/CPAN/Error-0.15/example | 51 monitoring/PerlModules/CPAN/Error-0.15/t/01throw.t | 25 monitoring/PerlModules/CPAN/Error-0.15/t/02order.t | 47 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/BUILD | 46 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Changes | 59 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/MANIFEST | 6 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Makefile.PL | 9 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/README | 64 monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/lib/HTML/TableExtract.pm | 1902 -------- monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/test.pl | 607 -- monitoring/PerlModules/CPAN/IO-stringy-1.219/BUILD | 42 monitoring/PerlModules/CPAN/IO-stringy-1.219/MANIFEST | 32 monitoring/PerlModules/CPAN/IO-stringy-1.219/Makefile.PL | 22 monitoring/PerlModules/CPAN/IO-stringy-1.219/README | 183 monitoring/PerlModules/CPAN/IO-stringy-1.219/README.system | 8 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/AtomicFile.pm.html | 101 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/InnerFile.pm.html | 126 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Lines.pm.html | 103 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Scalar.pm.html | 387 - monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/ScalarArray.pm.html | 338 - monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Stringy.pm.html | 315 - monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Wrap.pm.html | 169 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/WrapTie.pm.html | 418 - monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index-menu.html | 31 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.html | 13 monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.menu | 30 monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/AtomicFile.pm | 190 monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/InnerFile.pm | 274 - monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Lines.pm | 148 monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Scalar.pm | 674 --- monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/ScalarArray.pm | 598 -- monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Stringy.pm | 290 - monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Wrap.pm | 211 monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/WrapTie.pm | 480 -- monitoring/PerlModules/CPAN/IO-stringy-1.219/t/Common.pm | 255 - monitoring/PerlModules/CPAN/IO-stringy-1.219/t/ExtUtils/TBone.pm | 534 -- monitoring/PerlModules/CPAN/IO-stringy-1.219/t/IO_Lines.t | 43 monitoring/PerlModules/CPAN/IO-stringy-1.219/t/IO_Scalar.t | 121 monitoring/PerlModules/CPAN/IO-stringy-1.219/t/IO_ScalarArray.t | 49 monitoring/PerlModules/CPAN/IO-stringy-1.219/t/IO_WrapTie.t | 66 monitoring/PerlModules/CPAN/MIME-tools-5.410/BUILD | 46 monitoring/PerlModules/CPAN/MIME-tools-5.410/COPYING | 40 monitoring/PerlModules/CPAN/MIME-tools-5.410/INSTALLING | 26 monitoring/PerlModules/CPAN/MIME-tools-5.410/MANIFEST | 202 monitoring/PerlModules/CPAN/MIME-tools-5.410/Makefile.PL | 26 monitoring/PerlModules/CPAN/MIME-tools-5.410/README | 1434 ------ monitoring/PerlModules/CPAN/MIME-tools-5.410/README-OR-DIE | 75 monitoring/PerlModules/CPAN/MIME-tools-5.410/README.system | 8 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Body.pm.html | 492 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder.pm.html | 514 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/Base64.pm.html | 84 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/Binary.pm.html | 77 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/Gzip64.pm.html | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/NBit.pm.html | 147 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/QuotedPrint.pm.html | 85 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Decoder/UU.pm.html | 78 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Entity.pm.html | 1501 ------ monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Field/ConTraEnc.pm.html | 66 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Field/ContDisp.pm.html | 66 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Field/ContType.pm.html | 167 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Field/ParamVal.pm.html | 181 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Head.pm.html | 709 --- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Parser.pm.html | 1051 ---- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Parser/Filer.pm.html | 540 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Parser/Reader.pm.html | 62 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Parser/Results.pm.html | 125 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Tools.pm.html | 2038 --------- monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/WordDecoder.pm.html | 274 - monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/MIME/Words.pm.html | 240 - monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/index-menu.html | 81 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/index.html | 13 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/index.menu | 101 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimeabuse.html | 52 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimedump.html | 53 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimeencode.html | 60 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimeexplode.html | 86 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimepostcard.html | 60 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimeprint.html | 63 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimeref.html | 64 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimesend.html | 61 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimesender.html | 56 monitoring/PerlModules/CPAN/MIME-tools-5.410/docs/mimetour.html | 53 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/README | 10 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimeabuse | 53 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimedump | 99 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimeencode | 57 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimeexplode | 133 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimepostcard | 113 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimeprint | 85 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimeref | 145 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimesend | 150 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimesender | 48 monitoring/PerlModules/CPAN/MIME-tools-5.410/examples/mimetour | 56 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Body.pm | 680 --- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder.pm | 640 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/Base64.pm | 134 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/Binary.pm | 85 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/Gzip64.pm | 112 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/NBit.pm | 160 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/QuotedPrint.pm | 109 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Decoder/UU.pm | 151 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Entity.pm | 2242 ---------- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Field/ConTraEnc.pm | 59 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Field/ContDisp.pm | 64 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Field/ContType.pm | 202 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Field/ParamVal.pm | 307 - monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Head.pm | 907 ---- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Parser.pm | 1937 -------- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Parser/Filer.pm | 922 ---- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Parser/Reader.pm | 306 - monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Parser/Results.pm | 198 monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Tools.pm | 2002 -------- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/WordDecoder.pm | 618 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/lib/MIME/Words.pm | 406 - monitoring/PerlModules/CPAN/MIME-tools-5.410/patch | 16 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Body.t | 105 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Decoder.t | 88 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Entity.t | 339 - monitoring/PerlModules/CPAN/MIME-tools-5.410/t/ExtUtils/TBone.pm | 534 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Gauntlet.t | 122 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Globby.pm | 32 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Head.t | 167 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Misc.t | 119 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Parser.t | 134 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Ref.t | 275 - monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Tmpfile.topt | 32 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/WordDecoder.t | 45 monitoring/PerlModules/CPAN/MIME-tools-5.410/t/Words.t | 44 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/ak-0696.msg | 112 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/andreas-1296.txt | 173 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/andreas-1296.uu | 139 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/badbound.msg | 160 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/badfile.msg | 8 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/crlf.hdr | 17 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/encoded.hdr | 7 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/first.hdr | 7 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/fun.txt | 24 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/german.msg | 79 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/infinite.msg | 92 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/intl.msg | 12 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/jt-0498.msg | 107 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/lennie.msg | 81 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/mime-lg.b64 | 548 -- monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/mime-sm.b64 | 222 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/mp-msg-rfc822.msg | 112 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-2gifs.msg | 58 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-bad.msg | 181 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-badnames.msg | 30 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-clen.msg | 38 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-digest.msg | 23 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-igor.msg | 198 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-igor2.msg | 198 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-nested.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-nested2.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-nested3.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/multi-simple.msg | 23 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/not-mime.msg | 17 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/phil.b64 | 8 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/phil2.b64 | 4 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/quot-print.body | 41 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/second.hdr | 15 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/short.txt | 6 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/sig | 5 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/sig-uu.msg | 29 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/sig2 | 6 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/sig3 | 6 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/simple.msg | 20 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/simple.msgb | 13 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/simple.msgh | 7 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/third.hdr | 16 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/up.gif.uu | 6 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/words.txt | 44 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/x-gzip64.body | 5 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/x-gzip64.msg | 13 monitoring/PerlModules/CPAN/MIME-tools-5.410/testin/zeegee.gif.uu | 111 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/ak-0696-nest.ref | 34 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/ak-0696-none.ref | 26 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/ak-0696-replace.ref | 29 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/ak-0696.msg | 112 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/bluedot-postcard.msg | 138 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/bluedot-postcard.ref | 39 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/bluedot-simple.msg | 100 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/bluedot-simple.ref | 15 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/dup-names.msg | 78 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/dup-names.ref | 45 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/frag.msg | 1230 ----- monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/german.msg | 79 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/german.ref | 16 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/hdr-fakeout.msg | 15 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/hdr-fakeout.ref | 12 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-2evil.msg | 58 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-2evil.ref | 36 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-2gifs.msg | 57 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-2gifs.ref | 39 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-clen.msg | 40 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-clen.ref | 33 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-digest.msg | 30 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-digest.ref | 39 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-frag.msg | 90 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-igor.msg | 198 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-igor.ref | 43 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-igor2.msg | 198 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-igor2.ref | 43 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested.ref | 68 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested2.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested2.ref | 68 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested3.msg | 89 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-nested3.ref | 68 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-simple.msg | 23 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-simple.ref | 27 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-weirdspace.msg | 56 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/multi-weirdspace.ref | 35 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/re-fwd.msg | 33 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/re-fwd.ref | 33 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/russian.msg | 7 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/russian.ref | 12 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/simple.msg | 20 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/simple.ref | 16 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-junk-extracted.ref | 45 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-junk-target.msg | 182 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-junk.msg | 168 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-junk.ref | 26 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-zeegee.msg | 125 monitoring/PerlModules/CPAN/MIME-tools-5.410/testmsgs/uu-zeegee.ref | 34 proxy/installer/rhn-proxy-activate.sgml | 1 proxy/installer/spacewalk-proxy-installer.spec | 9 proxy/installer/squid.conf | 12 proxy/proxy/pm/rhn_package_manager.sgml | 1 proxy/proxy/rhn-proxy.sgml | 1 proxy/proxy/spacewalk-proxy.spec | 5 rel-eng/packages/osad | 2 rel-eng/packages/rhn-client-tools | 2 rel-eng/packages/rhn-virtualization | 2 rel-eng/packages/rhncfg | 2 rel-eng/packages/rhnlib | 2 rel-eng/packages/spacecmd | 2 rel-eng/packages/spacewalk-backend | 2 rel-eng/packages/spacewalk-java | 2 rel-eng/packages/spacewalk-proxy | 2 rel-eng/packages/spacewalk-proxy-installer | 2 rel-eng/packages/spacewalk-search | 2 rel-eng/packages/spacewalk-setup-jabberd | 2 rel-eng/packages/yum-rhn-plugin | 2 rel-eng/releasers.conf | 3 search-server/spacewalk-search/spacewalk-search.spec | 5 search-server/spacewalk-search/src/config/com/redhat/satellite/search/db/server.xml | 2 spacecmd/spacecmd.spec | 5 spacecmd/src/lib/system.py | 2 spacewalk/spacewalk-setup-jabberd/share/jabberd/s2s.xsl | 19 spacewalk/spacewalk-setup-jabberd/spacewalk-setup-jabberd.spec | 5 345 files changed, 303 insertions(+), 53664 deletions(-) New commits: commit 26f8a75351599245919db1ce1cd4b821068bc5b9 Merge: 115a7ec 679dee4 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 17:09:10 2011 +0200 Merge branch 'master' into ipv6 commit 679dee4c73727db3ee0c14a9e6aa1e3cbd1c3cb0 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 16:19:27 2011 +0200 Automatic commit of package [rhn-virtualization] release [5.4.29-1]. diff --git a/client/tools/rhn-virtualization/rhn-virtualization.spec b/client/tools/rhn-virtualization/rhn-virtualization.spec index 2aebabd..4feddff 100644 --- a/client/tools/rhn-virtualization/rhn-virtualization.spec +++ b/client/tools/rhn-virtualization/rhn-virtualization.spec @@ -10,7 +10,7 @@ License: GPLv2 URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz -Version: 5.4.28 +Version: 5.4.29 Release: 1%{?dist} BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildArch: noarch @@ -134,6 +134,9 @@ rm -rf $RPM_BUILD_ROOT %doc LICENSE %changelog +* Thu Oct 27 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 5.4.29-1 +- 742811 - domain_directory: R/O access to libvirtd is sufficient + * Wed Oct 26 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 5.4.28-1 - 742811 - don't open RW connection to libvirt unless necessary diff --git a/rel-eng/packages/rhn-virtualization b/rel-eng/packages/rhn-virtualization index 0905e4c..3efa35e 100644 --- a/rel-eng/packages/rhn-virtualization +++ b/rel-eng/packages/rhn-virtualization @@ -1 +1 @@ -5.4.28-1 client/tools/rhn-virtualization/ +5.4.29-1 client/tools/rhn-virtualization/ commit 1afa65491cda208e3078a3ba4864584c4be7856c Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 15:50:25 2011 +0200 add missing import diff --git a/client/rhel/rhn-client-tools/src/up2date_client/hardware.py b/client/rhel/rhn-client-tools/src/up2date_client/hardware.py index 0ccc99e..f2e68d8 100644 --- a/client/rhel/rhn-client-tools/src/up2date_client/hardware.py +++ b/client/rhel/rhn-client-tools/src/up2date_client/hardware.py @@ -15,7 +15,7 @@ # This thing gets the hardware configuraion out of a system """Used to read hardware info from kudzu, /proc, etc""" -from socket import gethostname, AF_INET, AF_INET6 +from socket import gethostname, getaddrinfo, AF_INET, AF_INET6 import socket import re import os commit fc890e3d54f21cf0498677d31e7bd672e71334b8 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 14:56:14 2011 +0200 typo fix diff --git a/backend/server/rhnServer/server_hardware.py b/backend/server/rhnServer/server_hardware.py index dd044e1..82a18ce 100644 --- a/backend/server/rhnServer/server_hardware.py +++ b/backend/server/rhnServer/server_hardware.py @@ -690,7 +690,7 @@ class Hardware: return 0 def save_hardware_byid(self, sysid): - """ ave the hardware list """ + """Save the hardware list """ log_debug(3, sysid, "changed = %s" % self.__changed) hardware = self.__hardware if hardware == {}: # nothing loaded commit 8ef8022f01ad030b0650d802fa7687977b25827b Merge: 40fba98 6f9a0a2 Author: Jan Hutar <jhutar(a)redhat.com> Date: Thu Oct 27 13:16:38 2011 +0200 Merge branch 'master' of ssh://git.fedorahosted.org/git/spacewalk commit 40fba986fc41301a45fa8862e0567ad3ec66b171 Author: Jan Hutar <jhutar(a)redhat.com> Date: Thu Oct 27 13:15:43 2011 +0200 Do not rely on exact amount of memomory when determinig PASS/FAIL diff --git a/client/rhel/rhnlib/test/24-ssl-memleak.py b/client/rhel/rhnlib/test/24-ssl-memleak.py index 387c740..88f9fed 100755 --- a/client/rhel/rhnlib/test/24-ssl-memleak.py +++ b/client/rhel/rhnlib/test/24-ssl-memleak.py @@ -20,24 +20,30 @@ def main(): except: pass server_url = "https://" + server_name + "/APPLET" - diff_count = 0 mem_usage = None + mem_usage_VmSize_max = None + mem_usage_VmSize_first = None + mem_usage_VmSize_allowed_percent = 0.1 # [%] allowed gain of first -> max for i in range(10000): run_test(server_url, ca_cert) if i % 100 == 0: new_mem_usage = mem_usage_int() if mem_usage is not None: - if mem_usage[1] != new_mem_usage[1]: - diff_count = diff_count + 1 + if new_mem_usage[1] > mem_usage_VmSize_max: + mem_usage_VmSize_max = new_mem_usage[1] + else: + mem_usage_VmSize_max = new_mem_usage[1] + mem_usage_VmSize_first = new_mem_usage[1] mem_usage = new_mem_usage print "memory usage: %s %s %s" % mem_usage[1:4] - if diff_count > 4: + percent = float((mem_usage_VmSize_max - mem_usage_VmSize_first)) / (float(mem_usage_VmSize_first) / 100) + if percent >= mem_usage_VmSize_allowed_percent: # Failure print "Test FAILS" - return diff_count + return 1 print "Test PASSES" return 0 commit 6f9a0a2692973012cb8dfefcbfb60ded810da409 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 16:47:09 2011 +0200 The KickstartSessionCreateCommand is duplicated in KickstartWizardHelper. diff --git a/java/code/src/com/redhat/rhn/domain/kickstart/KickstartData.java b/java/code/src/com/redhat/rhn/domain/kickstart/KickstartData.java index 18e370a..9bfa4ec 100644 --- a/java/code/src/com/redhat/rhn/domain/kickstart/KickstartData.java +++ b/java/code/src/com/redhat/rhn/domain/kickstart/KickstartData.java @@ -28,7 +28,6 @@ import com.redhat.rhn.domain.token.ActivationKeyFactory; import com.redhat.rhn.domain.token.Token; import com.redhat.rhn.domain.user.User; import com.redhat.rhn.manager.kickstart.KickstartFormatter; -import com.redhat.rhn.manager.kickstart.KickstartSessionCreateCommand; import com.redhat.rhn.manager.kickstart.cobbler.CobblerCommand; import com.redhat.rhn.manager.kickstart.cobbler.CobblerXMLRPCHelper; @@ -1171,11 +1170,6 @@ public class KickstartData { cloned.setNoBase(this.getNoBase()); cloned.setIgnoreMissing(this.getIgnoreMissing()); - //create a new session one - KickstartSessionCreateCommand cmd = new KickstartSessionCreateCommand( - user.getOrg(), cloned); - cmd.store(); - } // Helper method to copy KickstartCommands commit edcae0f1385122767616df7c98bdf67e7a69200d Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 15:23:38 2011 +0200 For the default_session, use better note in rhnregtoken table. Instead of Kickstart re-activation key for . say Default session activation key for profile rhel-5-7. diff --git a/java/code/src/com/redhat/rhn/frontend/strings/java/StringResource_en_US.xml b/java/code/src/com/redhat/rhn/frontend/strings/java/StringResource_en_US.xml index 8ce44ad..fda871a 100644 --- a/java/code/src/com/redhat/rhn/frontend/strings/java/StringResource_en_US.xml +++ b/java/code/src/com/redhat/rhn/frontend/strings/java/StringResource_en_US.xml @@ -6627,6 +6627,13 @@ Follow this url to see the full list of inactive systems: </context-group> </trans-unit> + <trans-unit id="kickstart.profile.default_session"> + <source>Default session activation key for profile {0}.</source> + <context-group name="ctx"> + <context context-type="sourcefile">/rhn/kickstart/CreateProfileWizard.do</context> + </context-group> + </trans-unit> + <trans-unit id="kickstart.session.newprofile"> <source>Profile for kickstart session {0}.</source> <context-group name="ctx"> diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java index baf55a0..7b0e909 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartSessionCreateCommand.java @@ -89,7 +89,7 @@ public class KickstartSessionCreateCommand { User user = UserFactory.findRandomOrgAdmin(owner); log.debug("Got random orgadmin: " + user.getLogin()); String note = LocalizationService.getInstance(). - getMessage("kickstart.session.newtokennote", " "); + getMessage("kickstart.profile.default_session", ksdata.getLabel()); log.debug("creating one-time-activation key: " + user.getLogin()); ActivationKey key = KickstartScheduleCommand.createKickstartActivationKey(user, commit 6be24fcf6d83540542dc003060985e119ba15f69 Author: Christian Berendt <berendt(a)b1-systems.de> Date: Thu Oct 27 11:42:47 2011 +0200 declare net.sf.antcontrib.logic.For task to fix create-webapp-dir diff --git a/java/buildconf/build-taskdefs.xml b/java/buildconf/build-taskdefs.xml index bca9305..a4d16b5 100644 --- a/java/buildconf/build-taskdefs.xml +++ b/java/buildconf/build-taskdefs.xml @@ -35,6 +35,8 @@ <taskdef resource="net/sf/antcontrib/antcontrib.properties" classpathref="buildjars"/> + <taskdef name="for" classname="net.sf.antcontrib.logic.For" onerror="report"/> + <property name="init-taskdefs.notrequired" value="true" />  commit 631fa35d6b642f9c6a687020ad31fa975e969741 Author: Christian Berendt <berendt(a)b1-systems.de> Date: Thu Oct 27 11:35:16 2011 +0200 adding xalan-j2 to the build.jar.dependencies property diff --git a/java/buildconf/build-props.xml b/java/buildconf/build-props.xml index 03cfc8e..5b81131 100644 --- a/java/buildconf/build-props.xml +++ b/java/buildconf/build-props.xml @@ -80,7 +80,7 @@ <property name="build.jar.dependencies" value="ant ant-junit ${ant-contrib.path} antlr ${common.jar.dependencies} tanukiwrapper ${tomcat-jars} ${jasper-jars} - concurrent" /> + concurrent xalan-j2" /> <property name="run.jar.dependencies" value="antlr ${asm} cglib c3p0 commons-discovery dom4j jaf jta commit e86ed29355375fa9d90366732980e8a9e3cf9276 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:56 2011 +0200 Revert "schema change" This reverts commit 780ba79c8d5edb50c312b522c6b8972db0d812a3. diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql deleted file mode 100644 index 6db6d3b..0000000 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ /dev/null @@ -1,38 +0,0 @@ --- --- Copyright (c) 2011 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- - - -CREATE TABLE rhnServerNetAddress4 -( - interface_id NUMBER NOT NULL - CONSTRAINT rhn_srv_net_iaddress4_iid_fk - REFERENCES rhnServerNetInterface (id), - address VARCHAR2(64), - netmask VARCHAR2(64), - broadcast VARCHAR2(64), - created DATE - DEFAULT (sysdate) NOT NULL, - modified DATE - DEFAULT (sysdate) NOT NULL -) -ENABLE ROW MOVEMENT -; - -CREATE INDEX rhn_srv_net_address4_iid_address_idx - ON rhnServerNetAddress4 (interface_id, address) - TABLESPACE [[8m_tbs]]; - -ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_srv_net_address4_iid_address_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql deleted file mode 100644 index dce721d..0000000 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ /dev/null @@ -1,38 +0,0 @@ --- --- Copyright (c) 2011 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- - - -CREATE TABLE rhnServerNetAddress6 -( - interface_id NUMBER NOT NULL - CONSTRAINT rhn_srv_net_iaddress6_iid_fk - REFERENCES rhnServerNetInterface (id), - address VARCHAR2(45), - netmask VARCHAR2(49), - scope VARCHAR2(64), - created DATE - DEFAULT (sysdate) NOT NULL, - modified DATE - DEFAULT (sysdate) NOT NULL -) -ENABLE ROW MOVEMENT -; - -CREATE INDEX rhn_srv_net_address6_iid_scope_address_idx - ON rhnServerNetAddress4 (interface_id, scope, address) - TABLESPACE [[8m_tbs]]; - -ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_srv_net_address6_iid_scope_address_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetInterface.sql b/schema/spacewalk/common/tables/rhnServerNetInterface.sql index 6d73c23..f115885 100644 --- a/schema/spacewalk/common/tables/rhnServerNetInterface.sql +++ b/schema/spacewalk/common/tables/rhnServerNetInterface.sql @@ -1,5 +1,5 @@ -- --- Copyright (c) 2008 -- 2011 Red Hat, Inc. +-- Copyright (c) 2008 Red Hat, Inc. -- -- This software is licensed to you under the GNU General Public License, -- version 2 (GPLv2). There is NO WARRANTY for this software, express or @@ -16,13 +16,13 @@ CREATE TABLE rhnServerNetInterface ( - id NUMBER NOT NULL - CONSTRAINT rhn_srv_net_iface_id_pk PRIMARY KEY - USING INDEX TABLESPACE [[4m_tbs]], server_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iface_sid_fk REFERENCES rhnServer (id), name VARCHAR2(32) NOT NULL, + ip_addr VARCHAR2(64), + netmask VARCHAR2(64), + broadcast VARCHAR2(64), hw_addr VARCHAR2(18), module VARCHAR2(128), created DATE @@ -40,4 +40,3 @@ CREATE INDEX rhn_srv_net_iface_sid_name_idx ALTER TABLE rhnServerNetInterface ADD CONSTRAINT rhn_srv_net_iface_sid_name_uq UNIQUE (server_id, name); -CREATE SEQUENCE rhn_srv_net_iface_id_seq; commit 592902bad18cbc1a8c872ef9f222245683f92fe4 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:51 2011 +0200 Revert "Fix table dependencies" This reverts commit 4c6f241a4cfe99cac08d18a63b969e815d10cbba. diff --git a/schema/spacewalk/common/tables/tables.deps b/schema/spacewalk/common/tables/tables.deps index 692e4b4..53fc6c7 100644 --- a/schema/spacewalk/common/tables/tables.deps +++ b/schema/spacewalk/common/tables/tables.deps @@ -105,8 +105,6 @@ rhnKickstartSessionHistory :: rhnKickstartSession rhnKickstartSessionState rhnKSTreeFile :: rhnKickstartableTree rhnChannelErrata rhnErrata \ rhnChecksum rhnKickstartTimezone :: rhnKSInstallType -rhnServerNetAddress4 :: rhnServerNetInterface -rhnServerNetAddress6 :: rhnServerNetInterface rhnOrgChannelSettings :: web_customer rhnChannel rhnOrgChannelSettingsType rhnOrgEntitlements :: rhnOrgEntitlementType rhnOrgErrataCacheQueue :: web_customer commit 91f3c5ca6d6969ef73f6cad1352e95658a60888a Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:46 2011 +0200 Revert "shorten constraint identifiers to fit into given limits" This reverts commit 72ab8d4d2e7516036ace9604eac51da399d6d1d1. diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index edf90ce..6db6d3b 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -30,10 +30,9 @@ CREATE TABLE rhnServerNetAddress4 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_net_addr4_iid_addr_idx +CREATE INDEX rhn_srv_net_address4_iid_address_idx ON rhnServerNetAddress4 (interface_id, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_net_add4_iid_addr_uq UNIQUE (interface_id, address); - + ADD CONSTRAINT rhn_srv_net_address4_iid_address_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index 7dbde6c..dce721d 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -30,10 +30,9 @@ CREATE TABLE rhnServerNetAddress6 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_net_addr6_iid_sc_addr_idx +CREATE INDEX rhn_srv_net_address6_iid_scope_address_idx ON rhnServerNetAddress4 (interface_id, scope, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_net_addr6_iid_sc_addr_uq UNIQUE (interface_id, scope, address); - + ADD CONSTRAINT rhn_srv_net_address6_iid_scope_address_uq UNIQUE (interface_id, scope, address); commit d6efd7c83469ae9aad804bc2e38f1393a346d556 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:40 2011 +0200 Revert "correct index creation" This reverts commit deb1ff2107ca7db37389e85bfdb39a79bad8e2b9. diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index 6413ba5..7dbde6c 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -31,7 +31,7 @@ ENABLE ROW MOVEMENT ; CREATE INDEX rhn_net_addr6_iid_sc_addr_idx - ON rhnServerNetAddress6 (interface_id, scope, address) + ON rhnServerNetAddress4 (interface_id, scope, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress6 commit f58d2f93f07b60fdf96fcfb138cd7dd8b165f0a5 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:35 2011 +0200 Revert "delete from rhnServerNetInterface: add on delete cascade" This reverts commit 7be1ad0da7a79a3a445437770540cfe0824850f5. diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index 7042fb2..edf90ce 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -18,8 +18,7 @@ CREATE TABLE rhnServerNetAddress4 ( interface_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iaddress4_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, + REFERENCES rhnServerNetInterface (id), address VARCHAR2(64), netmask VARCHAR2(64), broadcast VARCHAR2(64), diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index ee04fe5..6413ba5 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -18,8 +18,7 @@ CREATE TABLE rhnServerNetAddress6 ( interface_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iaddress6_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, + REFERENCES rhnServerNetInterface (id), address VARCHAR2(45), netmask VARCHAR2(49), scope VARCHAR2(64), commit 46e8fe27e393fe995595c79dfbc7a4bc6dc8f63f Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:29 2011 +0200 Revert "update rhn_server.get_ip_address() to reflect IPv6 changes" This reverts commit c8d1e52a302aaea688b049804bec6f441577d6e1. diff --git a/schema/spacewalk/oracle/packages/rhn_server.pkb b/schema/spacewalk/oracle/packages/rhn_server.pkb index 8e3c640..72392fd 100644 --- a/schema/spacewalk/oracle/packages/rhn_server.pkb +++ b/schema/spacewalk/oracle/packages/rhn_server.pkb @@ -712,12 +712,10 @@ is server_id_in in number ) return varchar2 is cursor interfaces is - select ni.name as name, na4.address as address - from rhnServerNetInterface ni, - rhnServerNetAddress4 na4 - where ni.server_id = server_id_in - and ni.id = na4.interface_id - and na4.address != '127.0.0.1'; + select name, ip_addr + from rhnServerNetInterface + where server_id = server_id_in + and ip_addr != '127.0.0.1'; cursor addresses is select ipaddr ip_addr from rhnServerNetwork @@ -728,7 +726,7 @@ is return addr.ip_addr; end loop; for iface in interfaces loop - return iface.address; + return iface.ip_addr; end loop; return NULL; end get_ip_address; diff --git a/schema/spacewalk/postgres/packages/rhn_server.pkb b/schema/spacewalk/postgres/packages/rhn_server.pkb index a1f7aca..3533094 100644 --- a/schema/spacewalk/postgres/packages/rhn_server.pkb +++ b/schema/spacewalk/postgres/packages/rhn_server.pkb @@ -764,12 +764,10 @@ update pg_settings set setting = 'rhn_server,' || setting where name = 'search_p ) returns varchar as $$ declare interfaces cursor is - select ni.name as name, na4.address as address - from rhnServerNetInterface ni, - rhnServerNetAddress4 na4 + select name, ip_addr + from rhnServerNetInterface where server_id = server_id_in - and ni.id = na4.interface_id - and na4.address != '127.0.0.1'; + and ip_addr != '127.0.0.1'; addresses cursor is select ipaddr ip_addr from rhnServerNetwork @@ -780,7 +778,7 @@ update pg_settings set setting = 'rhn_server,' || setting where name = 'search_p return addr.ip_addr; end loop; for iface in interfaces loop - return iface.address; + return iface.ip_addr; end loop; return NULL; end$$ language plpgsql; commit 5fac4e23c3a26784c0ba8a2d9c9e30b3be5dca93 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:23 2011 +0200 Revert "get_hw_info_as_clob: adapt to IPv6 changes" This reverts commit 08ea44500d91d22877f0f361735df518ae601bd7. diff --git a/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql b/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql index d6fea07..ce1b580 100644 --- a/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql +++ b/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql @@ -15,11 +15,9 @@ begin select 1 n, sum(nrcpu) || ' CPUs' m from rhncpu where rhncpu.server_id = sid union all - select 2, ni.name||' '||na4.address||'/'||na4.netmask||' '||ni.hw_addr val - from rhnservernetinterface ni, - rhnServerNetAddress4 na4 - where ni.server_id = sid - and ni.id = na4.interface_id + select 2, name||' '||ip_addr||'/'||netmask||' '||hw_addr val + from rhnservernetinterface + where rhnservernetinterface.server_id = sid ) order by n, m ) loop diff --git a/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql b/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql index 6cc1982..9d899f3 100644 --- a/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql +++ b/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql @@ -1,4 +1,4 @@ --- oracle equivalent source sha1 6a538f3b05d412810baec118fbb7860348c60cd4 +-- oracle equivalent source sha1 4a627f5b31efb66c684dd14f0514e25a5ace94f2 create or replace function get_hw_info_as_clob( sid in rhnserver.id%TYPE, @@ -17,11 +17,9 @@ begin select 1 n, sum(nrcpu) || ' CPUs' m from rhncpu where rhncpu.server_id = sid union all - select 2, ni.name||' '||coalesce(na4.address,'')||'/'||coalesce(na4.netmask,'')||' '||ni.hw_addr val - from rhnservernetinterface, - rhnServerNetAddress4 na4 - where ni.server_id = sid - and ni.id = na4.interface_id + select 2, name||' '||coalesce(ip_addr,'')||'/'||coalesce(netmask,'')||' '||hw_addr val + from rhnservernetinterface + where rhnservernetinterface.server_id = sid ) X order by n, m ) loop commit ece6447ff83de66444d7e939135c231c37419ce4 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:59:06 2011 +0200 Revert "schema upgrade" This reverts commit cee165a5cdd26112f2cc2cbb9774f894c10675b2. diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index b451aa3..7042fb2 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -31,10 +31,10 @@ CREATE TABLE rhnServerNetAddress4 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_srv_net_addr4_iid_addr_idx +CREATE INDEX rhn_net_addr4_iid_addr_idx ON rhnServerNetAddress4 (interface_id, address) - TABLESPACE [[64k_tbs]]; + TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_srv_net_addr4_iid_addr_uq UNIQUE (interface_id, address); + ADD CONSTRAINT rhn_net_add4_iid_addr_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index 79b10e4..ee04fe5 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -31,10 +31,10 @@ CREATE TABLE rhnServerNetAddress6 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_srv_net_ad6_iid_sc_ad_idx +CREATE INDEX rhn_net_addr6_iid_sc_addr_idx ON rhnServerNetAddress6 (interface_id, scope, address) - TABLESPACE [[64_tbs]]; + TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_srv_net_ad6_iid_sc_ad_uq UNIQUE (interface_id, scope, address); + ADD CONSTRAINT rhn_net_addr6_iid_sc_addr_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle deleted file mode 100644 index 1f0ab2a..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle +++ /dev/null @@ -1,9 +0,0 @@ -alter table rhnServerNetInterface add id number; - -create sequence rhn_srv_net_iface_id_seq; - -update rhnServerNetInterface set id = rhn_srv_net_iface_id_seq.nextval; - -alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_nn check (id is not null); - -alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_pk primary key ( id ); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql deleted file mode 100644 index c2b448d..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql +++ /dev/null @@ -1,11 +0,0 @@ --- oracle equivalent source sha1 f5872e029cf1b053c88bd876afc8f253461772ac - -alter table rhnServerNetInterface add id numeric; - -create sequence rhn_srv_net_iface_id_seq; - -update rhnServerNetInterface set id = nextval('rhn_srv_net_iface_id_seq'); - -alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_nn check (id is not null); - -alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_pk primary key ( id ); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle deleted file mode 100644 index 7922fdf..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle +++ /dev/null @@ -1,39 +0,0 @@ --- --- Copyright (c) 2011 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- - - -CREATE TABLE rhnServerNetAddress4 -( - interface_id NUMBER NOT NULL - CONSTRAINT rhn_srv_net_iaddress4_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, - address VARCHAR2(64), - netmask VARCHAR2(64), - broadcast VARCHAR2(64), - created DATE - DEFAULT (sysdate) NOT NULL, - modified DATE - DEFAULT (sysdate) NOT NULL -) -ENABLE ROW MOVEMENT -; - -CREATE INDEX rhn_srv_net_addr4_iid_addr_idx - ON rhnServerNetAddress4 (interface_id, address) - TABLESPACE [[64k_tbs]]; - -ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_srv_net_addr4_iid_addr_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql deleted file mode 100644 index 7b8a6b7..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql +++ /dev/null @@ -1,18 +0,0 @@ --- oracle equivalent source sha1 af31dbcccd3799c2cd577137f6f7fd608288b2c4 - -CREATE TABLE rhnServerNetAddress4 -( - interface_id NUMERIC NOT NULL - CONSTRAINT rhn_srv_net_iaddress4_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, - address VARCHAR(64), - netmask VARCHAR(64), - broadcast VARCHAR(64), - created timestamptz default current_timestamp NOT NULL, - modified timestamptz default current_timestamp NOT NULL -); - -CREATE UNIQUE INDEX rhn_srv_net_addr4_iid_addr_uq - ON rhnServerNetAddress4 (interface_id, address) - ; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql deleted file mode 100644 index bda4fb8..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql +++ /dev/null @@ -1,6 +0,0 @@ -INSERT INTO rhnServerNetAddress4 - (interface_id, address, netmask, broadcast, created) - SELECT id, ip_addr, netmask, broadcast, created - FROM rhnServerNetInterface; - -COMMIT; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql deleted file mode 100644 index 64e42e1..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql +++ /dev/null @@ -1,3 +0,0 @@ -ALTER TABLE rhnServerNetInterface DROP COLUMN ip_addr; -ALTER TABLE rhnServerNetInterface DROP COLUMN netmask; -ALTER TABLE rhnServerNetInterface DROP COLUMN broadcast; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle deleted file mode 100644 index 42c78b2..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle +++ /dev/null @@ -1,39 +0,0 @@ --- --- Copyright (c) 2011 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- - - -CREATE TABLE rhnServerNetAddress6 -( - interface_id NUMBER NOT NULL - CONSTRAINT rhn_srv_net_iaddress6_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, - address VARCHAR2(45), - netmask VARCHAR2(49), - scope VARCHAR2(64), - created DATE - DEFAULT (sysdate) NOT NULL, - modified DATE - DEFAULT (sysdate) NOT NULL -) -ENABLE ROW MOVEMENT -; - -CREATE INDEX rhn_srv_net_ad6_iid_sc_ad_idx - ON rhnServerNetAddress6 (interface_id, scope, address) - TABLESPACE [[64k_tbs]]; - -ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_srv_net_ad6_iid_sc_ad_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql deleted file mode 100644 index 844c601..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql +++ /dev/null @@ -1,17 +0,0 @@ --- oracle equivalent source sha1 7c11068302cdb144f446828d4db0f244dbf12293 - -CREATE TABLE rhnServerNetAddress6 -( - interface_id NUMERIC NOT NULL - CONSTRAINT rhn_srv_net_iaddress6_iid_fk - REFERENCES rhnServerNetInterface (id) - ON DELETE CASCADE, - address VARCHAR(45), - netmask VARCHAR(49), - scope VARCHAR(64), - created timestamptz default current_timestamp NOT NULL, - modified timestamptz default current_timestamp NOT NULL -); - -CREATE UNIQUE INDEX rhn_srv_net_ad6_iid_sc_ad_uq - ON rhnServerNetAddress6 (interface_id, scope, address); commit ad7c7f9205397e99007de90b14c7be5ad39f9500 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:58:07 2011 +0200 Revert "upgrade script for rhn_server.pkb" This reverts commit aa6a12287e103d424ebf882cf0dc003ea9c93e91. diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle deleted file mode 100644 index 87600df..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle +++ /dev/null @@ -1,750 +0,0 @@ --- --- Copyright (c) 2008--2010 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- --- --- --- - -create or replace -package body rhn_server -is - function system_service_level( - server_id_in in number, - service_level_in in varchar2 - ) return number is - - cursor ents is - select label from rhnServerEntitlementView - where server_id = server_id_in; - - retval number := 0; - - begin - for ent in ents loop - retval := rhn_entitlements.entitlement_grants_service (ent.label, service_level_in); - if retval = 1 then - return retval; - end if; - end loop; - - return retval; - - end system_service_level; - - - function can_change_base_channel(server_id_in IN NUMBER) - return number - is - throwaway number; - begin - -- the idea: if we get past this query, the server is - -- neither sat nor proxy, so base channel is changeable - - select 1 into throwaway - from rhnServer S - where S.id = server_id_in - and not exists (select 1 from rhnSatelliteInfo SI where SI.server_id = S.id) - and not exists (select 1 from rhnProxyInfo PI where PI.server_id = S.id); - - return 1; - exception - when no_data_found - then - return 0; - end can_change_base_channel; - - procedure set_custom_value( - server_id_in in number, - user_id_in in number, - key_label_in in varchar2, - value_in in varchar2 - ) is - key_id_val number; - begin - select CDK.id into key_id_val - from rhnCustomDataKey CDK, - rhnServer S - where S.id = server_id_in - and S.org_id = CDK.org_id - and CDK.label = key_label_in; - - begin - insert into rhnServerCustomDataValue (server_id, key_id, value, created_by, last_modified_by) - values (server_id_in, key_id_val, value_in, user_id_in, user_id_in); - exception - when DUP_VAL_ON_INDEX - then - update rhnServerCustomDataValue - set value = value_in, - last_modified_by = user_id_in - where server_id = server_id_in - and key_id = key_id_val; - end; - - end set_custom_value; - - function bulk_set_custom_value( - key_label_in in varchar2, - value_in in varchar2, - set_label_in in varchar2, - set_uid_in in number - ) - return integer - is - i integer := 0; - begin - i := 0; - for server in rhn_set.set_iterator(set_label_in, set_uid_in) - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - rhn_server.set_custom_value(server.element, set_uid_in, key_label_in, value_in); - i := i + 1; - end if; - end loop server; - return i; - end bulk_set_custom_value; - - procedure bulk_snapshot_tag( - org_id_in in number, - tagname_in in varchar2, - set_label_in in varchar2, - set_uid_in in number - ) is - snapshot_id number; - begin - for server in rhn_set.set_iterator(set_label_in, set_uid_in) - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - begin - select max(id) into snapshot_id - from rhnSnapshot - where server_id = server.element; - exception - when NO_DATA_FOUND then - rhn_server.snapshot_server(server.element, 'tagging system: ' || tagname_in); - - select max(id) into snapshot_id - from rhnSnapshot - where server_id = server.element; - end; - - -- now have a snapshot_id to work with... - begin - rhn_server.tag_snapshot(snapshot_id, org_id_in, tagname_in); - exception - when DUP_VAL_ON_INDEX - then - -- do nothing, be forgiving... - null; - end; - end if; - end loop server; - end bulk_snapshot_tag; - - procedure tag_delete( - server_id_in in number, - tag_id_in in number - ) is - cursor snapshots is - select snapshot_id - from rhnSnapshotTag - where tag_id = tag_id_in; - tag_id_tmp number; - begin - select id into tag_id_tmp - from rhnTag - where id = tag_id_in - for update; - - delete - from rhnSnapshotTag - where server_id = server_id_in - and tag_id = tag_id_in; - for snapshot in snapshots loop - return; - end loop; - delete - from rhnTag - where id = tag_id_in; - end tag_delete; - - procedure tag_snapshot( - snapshot_id_in in number, - org_id_in in number, - tagname_in in varchar2 - ) is - begin - insert into rhnSnapshotTag (snapshot_id, server_id, tag_id) - select snapshot_id_in, server_id, lookup_tag(org_id_in, tagname_in) - from rhnSnapshot - where id = snapshot_id_in; - end tag_snapshot; - - procedure bulk_snapshot( - reason_in in varchar2, - set_label_in in varchar2, - set_uid_in in number - ) is - begin - for server in rhn_set.set_iterator(set_label_in, set_uid_in) - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - rhn_server.snapshot_server(server.element, reason_in); - end if; - end loop server; - end bulk_snapshot; - - procedure snapshot_server( - server_id_in in number, - reason_in in varchar2 - ) is - snapshot_id number; - cursor revisions is - select distinct - cr.id - from rhnConfigRevision cr, - rhnConfigFileName cfn, - rhnConfigFile cf, - rhnConfigChannel cc, - rhnServerConfigChannel scc - where 1=1 - and scc.server_id = server_id_in - and scc.config_channel_id = cc.id - and cc.id = cf.config_channel_id - and cf.id = cr.config_file_id - and cr.id = cf.latest_config_revision_id - and cf.config_file_name_id = cfn.id - and cf.id = lookup_first_matching_cf(scc.server_id, cfn.path); - locked integer; - begin - select rhn_snapshot_id_seq.nextval into snapshot_id from dual; - - insert into rhnSnapshot (id, org_id, server_id, reason) ( - select snapshot_id, - s.org_id, - server_id_in, - reason_in - from rhnServer s - where s.id = server_id_in - ); - insert into rhnSnapshotChannel (snapshot_id, channel_id) ( - select snapshot_id, sc.channel_id - from rhnServerChannel sc - where sc.server_id = server_id_in - ); - insert into rhnSnapshotServerGroup (snapshot_id, server_group_id) ( - select snapshot_id, sgm.server_group_id - from rhnServerGroupMembers sgm - where sgm.server_id = server_id_in - ); - locked := 0; - while true loop - begin - insert into rhnPackageNEVRA (id, name_id, evr_id, package_arch_id) - select rhn_pkgnevra_id_seq.nextval, sp.name_id, sp.evr_id, sp.package_arch_id - from rhnServerPackage sp - where sp.server_id = server_id_in - and not exists - (select 1 - from rhnPackageNEVRA nevra - where nevra.name_id = sp.name_id - and nevra.evr_id = sp.evr_id - and (nevra.package_arch_id = sp.package_arch_id - or (nevra.package_arch_id is null - and sp.package_arch_id is null))); - exit; - exception when dup_val_on_index then - if locked = 1 then - raise; - else - lock table rhnPackageNEVRA in exclusive mode; - locked := 1; - end if; - end; - end loop; - insert into rhnSnapshotPackage (snapshot_id, nevra_id) ( - select distinct snapshot_id, nevra.id - from rhnServerPackage sp, rhnPackageNEVRA nevra - where sp.server_id = server_id_in - and nevra.name_id = sp.name_id - and nevra.evr_id = sp.evr_id - and (nevra.package_arch_id = sp.package_arch_id - or (nevra.package_arch_id is null - and sp.package_arch_id is null)) - ); - - insert into rhnSnapshotConfigChannel ( snapshot_id, config_channel_id ) ( - select snapshot_id, scc.config_channel_id - from rhnServerConfigChannel scc - where server_id = server_id_in - ); - - for revision in revisions loop - insert into rhnSnapshotConfigRevision ( - snapshot_id, config_revision_id - ) values ( - snapshot_id, revision.id - ); - end loop; - end snapshot_server; - - procedure remove_action( - server_id_in in number, - action_id_in in number - ) is - -- this really wants "nulls last", but 8.1.7.3.0 sucks ass. - -- instead, we make a local table that holds our - -- list of ids with null prereqs. There's surely a better way - -- (an array instead of a table maybe? who knows...) - -- but I've got code to do this handy that I can look at ;) - cursor chained_actions is - select id, prerequisite - from rhnAction - start with id = action_id_in - connect by prior id = prerequisite - order by prerequisite desc; - cursor sessions is - select s.id - from rhnKickstartSession s - where server_id_in in (s.old_server_id, s.new_server_id) - and s.action_id = action_id_in - and not exists ( - select 1 - from rhnKickstartSessionState ss - where ss.id = s.state_id - and ss.label in ('failed','complete') - ); - type chain_end_type is table of number index by binary_integer; - chain_ends chain_end_type; - i number; - prereq number := 1; - begin - select prerequisite - into prereq - from rhnAction - where id = action_id_in; - - if prereq is not null then - rhn_exception.raise_exception('action_is_child'); - end if; - - i := 0; - for action in chained_actions loop - if action.prerequisite is null then - chain_ends(i) := action.id; - i := i + 1; - else - delete from rhnServerAction - where server_id = server_id_in - and action_id = action.id; - end if; - end loop; - i := chain_ends.first; - while i is not null loop - delete from rhnServerAction - where server_id = server_id_in - and action_id = chain_ends(i); - i := chain_ends.next(i); - end loop; - for s in sessions loop - update rhnKickstartSession - set state_id = ( - select id - from rhnKickstartSessionState - where label = 'failed' - ), - action_id = null - where id = s.id; - set_ks_session_history_message(s.id, 'failed', 'Kickstart cancelled due to action removal'); - end loop; - end remove_action; - - function check_user_access(server_id_in in number, user_id_in in number) - return number - is - has_access number; - begin - -- first check; if this returns no rows, then the server/user are in different orgs, and we bail - select 1 into has_access - from rhnServer S, - web_contact wc - where wc.org_id = s.org_id - and s.id = server_id_in - and wc.id = user_id_in; - - -- okay, so they're in the same org. if we have an org admin, they get a free pass - if rhn_user.check_role(user_id_in, 'org_admin') = 1 - then - return 1; - end if; - - select 1 into has_access - from rhnServerGroupMembers SGM, - rhnUserServerGroupPerms USG - where SGM.server_group_id = USG.server_group_id - and SGM.server_id = server_id_in - and USG.user_id = user_id_in - and rownum = 1; - - return 1; - exception - when no_data_found - then - return 0; - end check_user_access; - - -- ******************************************************************* - -- FUNCTION: can_server_consume_virt_slot - -- Returns 1 if the server id is eligible to consume a virtual slot, - -- else returns 0. - -- Called by: insert_into_servergroup, delete_from_servergroup - -- ******************************************************************* - function can_server_consume_virt_slot(server_id_in in number, - group_type_in in - rhnServerGroupType.label%TYPE) - return number - is - - cursor server_virt_slots is - select vi.VIRTUAL_SYSTEM_ID - from - rhnVirtualInstance vi - where - -- server id is a virtual instance - vi.VIRTUAL_SYSTEM_ID = server_id_in - -- server id's host is virt entitled - and exists ( select 1 - from rhnServerEntitlementView sev - where vi.HOST_SYSTEM_ID = sev.server_id - and sev.label in ('virtualization_host', - 'virtualization_host_platform') ) - -- server id's host also has the ent we want - and exists ( select 1 - from rhnServerEntitlementView sev2 - where vi.HOST_SYSTEM_ID = sev2.server_id - and sev2.label = group_type_in ); - - begin - for server_virt_slot in server_virt_slots loop - return 1; - end loop; - return 0; - end can_server_consume_virt_slot; - - - procedure insert_into_servergroup ( - server_id_in in number, - server_group_id_in in number - ) is - used_slots number; - max_slots number; - org_id number; - mgmt_available number; - mgmt_upgrade number; - mgmt_sgid number; - prov_available number; - prov_upgrade number; - prov_sgid number; - group_label rhnServerGroupType.label%TYPE; - group_type number; - begin - -- frist, group_type = null, because it's easy... - - -- this will rowlock the servergroup we're trying to change; - -- we probably need to lock the other one, but I think the chances - -- of it being a real issue are very small for now... - select sg.group_type, sg.org_id, sg.current_members, sg.max_members - into group_type, org_id, used_slots, max_slots - from rhnServerGroup sg - where sg.id = server_group_id_in - for update of sg.current_members; - - if group_type is null then - if used_slots >= max_slots then - rhn_exception.raise_exception('servergroup_max_members'); - end if; - - insert into rhnServerGroupMembers( - server_id, server_group_id - ) values ( - server_id_in, server_group_id_in - ); - update rhnServerGroup - set current_members = current_members + 1 - where id = server_group_id_in; - - rhn_cache.update_perms_for_server_group(server_group_id_in); - return; - end if; - - -- now for group_type != null - -- - select label - into group_label - from rhnServerGroupType sgt - where sgt.id = group_type; - - -- the naive easy path that gets hit most often and has to be quickest. - if group_label in ('sw_mgr_entitled', - 'enterprise_entitled', - 'monitoring_entitled', - 'provisioning_entitled', - 'virtualization_host', - 'virtualization_host_platform') then - if used_slots >= max_slots and - (can_server_consume_virt_slot(server_id_in, group_label) != 1) - then - rhn_exception.raise_exception('servergroup_max_members'); - end if; - - insert into rhnServerGroupMembers( - server_id, server_group_id - ) values ( - server_id_in, server_group_id_in - ); - - -- Only update current members if the system in consuming a - -- physical slot. - if can_server_consume_virt_slot(server_id_in, group_label) = 0 then - update rhnServerGroup - set current_members = current_members + 1 - where id = server_group_id_in; - end if; - - return; - end if; - end; - - function insert_into_servergroup_maybe ( - server_id_in in number, - server_group_id_in in number - ) return number is - retval number := 0; - cursor servergroups is - select s.id server_id, - sg.id server_group_id - from rhnServerGroup sg, - rhnServer s - where s.id = server_id_in - and sg.id = server_group_id_in - and s.org_id = sg.org_id - and not exists ( - select 1 - from rhnServerGroupMembers sgm - where sgm.server_id = s.id - and sgm.server_group_id = sg.id - ); - begin - for sgm in servergroups loop - rhn_server.insert_into_servergroup(sgm.server_id, sgm.server_group_id); - retval := retval + 1; - end loop; - return retval; - end insert_into_servergroup_maybe; - - procedure insert_set_into_servergroup ( - server_group_id_in in number, - user_id_in in number, - set_label_in in varchar2 - ) is - cursor servers is - select st.element id - from rhnSet st - where st.user_id = user_id_in - and st.label = set_label_in - and exists ( - select 1 - from rhnUserManagedServerGroups umsg - where umsg.server_group_id = server_group_id_in - and umsg.user_id = user_id_in - ) - and not exists ( - select 1 - from rhnServerGroupMembers sgm - where sgm.server_id = st.element - and sgm.server_group_id = server_group_id_in - ); - begin - for s in servers loop - rhn_server.insert_into_servergroup(s.id, server_group_id_in); - end loop; - end insert_set_into_servergroup; - - procedure delete_from_servergroup ( - server_id_in in number, - server_group_id_in in number - ) is - cursor server_virt_groups is - select 1 - from rhnServerEntitlementVirtual sev - where sev.server_id = server_id_in - and sev.server_group_id = server_group_id_in; - - oid number; - mgmt_sgid number; - label rhnServerGroupType.label%TYPE; - group_type number; - begin - begin - select sg.group_type, sg.org_id - into group_type, oid - from rhnServerGroupMembers sgm, - rhnServerGroup sg - where sg.id = server_group_id_in - and sg.id = sgm.server_group_id - and sgm.server_id = server_id_in - for update of sg.current_members; - exception - when no_data_found then - rhn_exception.raise_exception('server_not_in_group'); - end; - - -- do group_type is null first - if group_type is null then - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - update rhnServerGroup - set current_members = current_members - 1 - where id = server_group_id_in; - rhn_cache.update_perms_for_server_group(server_group_id_in); - return; - end if; - - select sgt.label - into label - from rhnServerGroupType sgt - where sgt.id = group_type; - - if label in ('sw_mgr_entitled', - 'enterprise_entitled', - 'provisioning_entitled', - 'monitoring_entitled', - 'virtualization_host', - 'virtualization_host_platform') then - - -- Only update current members if the system is consuming - -- a physical slot. - for server_virt_group in server_virt_groups loop - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - return; - end loop; - - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - - update rhnServerGroup - set current_members = current_members - 1 - where id = server_group_id_in; - - end if; - end; - - procedure delete_set_from_servergroup ( - server_group_id_in in number, - user_id_in in number, - set_label_in in varchar2 - ) is - cursor servergroups is - select sgm.server_id, sgm.server_group_id - from rhnSet st, - rhnServerGroupMembers sgm - where sgm.server_group_id = server_group_id_in - and st.user_id = user_id_in - and st.label = set_label_in - and sgm.server_id = st.element - and exists ( - select 1 - from rhnUserManagedServerGroups usgp - where usgp.server_group_id = server_group_id_in - and usgp.user_id = user_id_in - ); - begin - for sgm in servergroups loop - rhn_server.delete_from_servergroup(sgm.server_id, server_group_id_in); - end loop; - end delete_set_from_servergroup; - - procedure clear_servergroup ( - server_group_id_in in number - ) is - cursor servers is - select sgm.server_id id - from rhnServerGroupMembers sgm - where sgm.server_group_id = server_group_id_in; - begin - for s in servers loop - rhn_server.delete_from_servergroup(s.id, server_group_id_in); - end loop; - end clear_servergroup; - - procedure delete_from_org_servergroups ( - server_id_in in number - ) is - cursor servergroups is - select sgm.server_group_id id - from rhnServerGroup sg, - rhnServerGroupMembers sgm - where sgm.server_id = server_id_in - and sgm.server_group_id = sg.id - and sg.group_type is null; - begin - for sg in servergroups loop - rhn_server.delete_from_servergroup(server_id_in, sg.id); - end loop; - end delete_from_org_servergroups; - - function get_ip_address ( - server_id_in in number - ) return varchar2 is - cursor interfaces is - select ni.name as name, na4.address as address - from rhnServerNetInterface ni, - rhnServerNetAddress4 na4 - where ni.server_id = server_id_in - and ni.id = na4.interface_id - and na4.address != '127.0.0.1'; - cursor addresses is - select ipaddr ip_addr - from rhnServerNetwork - where server_id = server_id_in - and ipaddr != '127.0.0.1'; - begin - for addr in addresses loop - return addr.ip_addr; - end loop; - for iface in interfaces loop - return iface.address; - end loop; - return NULL; - end get_ip_address; - - procedure update_needed_cache(server_id_in in number) - is - begin - delete from rhnServerNeededCache - where server_id = server_id_in; - insert into rhnServerNeededCache - (server_id, errata_id, package_id) - (select distinct server_id, errata_id, package_id - from rhnServerNeededView - where server_id = server_id_in); - end update_needed_cache; - -end rhn_server; -/ -SHOW ERRORS diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql deleted file mode 100644 index d103a65..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql +++ /dev/null @@ -1,802 +0,0 @@ --- --- Copyright (c) 2008--2010 Red Hat, Inc. --- --- This software is licensed to you under the GNU General Public License, --- version 2 (GPLv2). There is NO WARRANTY for this software, express or --- implied, including the implied warranties of MERCHANTABILITY or FITNESS --- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 --- along with this software; if not, see --- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. --- --- Red Hat trademarks are not licensed under GPLv2. No permission is --- granted to use or replicate Red Hat trademarks that are incorporated --- in this software or its documentation. --- --- --- --- - -create schema rhn_server; - ---update pg_setting -update pg_settings set setting = 'rhn_server,' || setting where name = 'search_path'; - - create or replace function system_service_level( - server_id_in in numeric, - service_level_in in varchar - ) returns numeric as $$ - declare - ents cursor is - select label from rhnServerEntitlementView - where server_id = server_id_in; - - retval numeric := 0; - - begin - for ent in ents loop - retval := rhn_entitlements.entitlement_grants_service (ent.label, service_level_in); - if retval = 1 then - return retval; - end if; - end loop; - - return retval; - - end$$ language plpgsql; - - - create or replace function can_change_base_channel(server_id_in IN NUMERIC) - returns numeric - as $$ - declare - throwaway numeric; - begin - -- the idea: if we get past this query, the server is - -- neither sat nor proxy, so base channel is changeable - - select 1 into throwaway - from rhnServer S - where S.id = server_id_in - and not exists (select 1 from rhnSatelliteInfo SI where SI.server_id = S.id) - and not exists (select 1 from rhnProxyInfo PI where PI.server_id = S.id); - - if not found then - return 0; - end if; - - return 1; - end$$ language plpgsql; - - create or replace function set_custom_value( - server_id_in in numeric, - user_id_in in numeric, - key_label_in in varchar, - value_in in varchar - ) returns void - as $$ - declare - key_id_val numeric; - begin - select CDK.id into strict key_id_val - from rhnCustomDataKey CDK, - rhnServer S - where S.id = server_id_in - and S.org_id = CDK.org_id - and CDK.label = key_label_in; - - begin - insert into rhnServerCustomDataValue (server_id, key_id, value, created_by, last_modified_by) - values (server_id_in, key_id_val, value_in, user_id_in, user_id_in); - exception - when UNIQUE_VIOLATION - then - update rhnServerCustomDataValue - set value = value_in, - last_modified_by = user_id_in - where server_id = server_id_in - and key_id = key_id_val; - end; - - end$$ language plpgsql; - - create or replace function bulk_set_custom_value( - key_label_in in varchar, - value_in in varchar, - set_label_in in varchar, - set_uid_in in numeric - ) - returns integer - as $$ - declare - i integer; - server record; - begin - i := 0; - for server in - SELECT user_id, label, element, element_two - FROM rhnSet - WHERE label = set_label_in - AND user_id = set_uid_in - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - perform rhn_server.set_custom_value(server.element, set_uid_in, key_label_in, value_in); - i := i + 1; - end if; - end loop; - return i; - end$$ language plpgsql; - - create or replace function bulk_snapshot_tag( - org_id_in in numeric, - tagname_in in varchar, - set_label_in in varchar, - set_uid_in in numeric - ) returns void - as $$ - declare - server record; - snapshot_id numeric; - begin - for server in - SELECT user_id, label, element, element_two - FROM rhnSet - WHERE label = set_label_in - AND user_id = set_uid_in - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - select max(id) into snapshot_id - from rhnSnapshot - where server_id = server.element; - - if snapshot_id is null then - perform rhn_server.snapshot_server(server.element, 'tagging system: ' || tagname_in); - - select max(id) into snapshot_id - from rhnSnapshot - where server_id = server.element; - end if; - - -- now have a snapshot_id to work with... - begin - perform rhn_server.tag_snapshot(snapshot_id, org_id_in, tagname_in); - exception - when UNIQUE_VIOLATION - then - -- do nothing, be forgiving... - null; - end; - end if; - end loop; - end$$ language plpgsql; - - create or replace function tag_delete( - server_id_in in numeric, - tag_id_in in numeric - ) returns void - as $$ - declare - snapshots cursor is - select snapshot_id - from rhnSnapshotTag - where tag_id = tag_id_in; - tag_id_tmp numeric; - begin - select id into tag_id_tmp - from rhnTag - where id = tag_id_in - for update; - - delete - from rhnSnapshotTag - where server_id = server_id_in - and tag_id = tag_id_in; - for snapshot in snapshots loop - return; - end loop; - delete - from rhnTag - where id = tag_id_in; - end$$ language plpgsql; - - create or replace function tag_snapshot( - snapshot_id_in in numeric, - org_id_in in numeric, - tagname_in in varchar - ) returns void - as $$ - begin - insert into rhnSnapshotTag (snapshot_id, server_id, tag_id) - select snapshot_id_in, server_id, lookup_tag(org_id_in, tagname_in) - from rhnSnapshot - where id = snapshot_id_in; - end$$ language plpgsql; - - create or replace function bulk_snapshot( - reason_in in varchar, - set_label_in in varchar, - set_uid_in in numeric - ) returns void - as $$ - declare - server record; - begin - for server in - SELECT user_id, label, element, element_two - FROM rhnSet - WHERE label = set_label_in - AND user_id = set_uid_in - loop - if rhn_server.system_service_level(server.element, 'provisioning') = 1 then - perform rhn_server.snapshot_server(server.element, reason_in); - end if; - end loop; - end$$ language plpgsql; - - create or replace function snapshot_server( - server_id_in in numeric, - reason_in in varchar - ) returns void - as $$ - declare - snapshot_id_v numeric; - revisions cursor is - select distinct - cr.id - from rhnConfigRevision cr, - rhnConfigFileName cfn, - rhnConfigFile cf, - rhnConfigChannel cc, - rhnServerConfigChannel scc - where 1=1 - and scc.server_id = server_id_in - and scc.config_channel_id = cc.id - and cc.id = cf.config_channel_id - and cf.id = cr.config_file_id - and cr.id = cf.latest_config_revision_id - and cf.config_file_name_id = cfn.id - and cf.id = lookup_first_matching_cf(scc.server_id, cfn.path); - locked integer; - begin - select nextval('rhn_snapshot_id_seq') into snapshot_id_v; - - insert into rhnSnapshot (id, org_id, server_id, reason) ( - select snapshot_id_v, - s.org_id, - server_id_in, - reason_in - from rhnServer s - where s.id = server_id_in - ); - insert into rhnSnapshotChannel (snapshot_id, channel_id) ( - select snapshot_id_v, sc.channel_id - from rhnServerChannel sc - where sc.server_id = server_id_in - ); - insert into rhnSnapshotServerGroup (snapshot_id, server_group_id) ( - select snapshot_id_v, sgm.server_group_id - from rhnServerGroupMembers sgm - where sgm.server_id = server_id_in - ); - locked := 0; - <<iloop>> - while true loop - begin - insert into rhnPackageNEVRA (id, name_id, evr_id, package_arch_id) - select nextval('rhn_pkgnevra_id_seq'), sp.name_id, sp.evr_id, sp.package_arch_id - from rhnServerPackage sp - where sp.server_id = server_id_in - and not exists - (select 1 - from rhnPackageNEVRA nevra - where nevra.name_id = sp.name_id - and nevra.evr_id = sp.evr_id - and (nevra.package_arch_id = sp.package_arch_id - or (nevra.package_arch_id is null - and sp.package_arch_id is null))); - exit iloop; - exception when unique_violation then - if locked = 1 then - raise; - else - lock table rhnPackageNEVRA in exclusive mode; - locked := 1; - end if; - end; - end loop; - insert into rhnSnapshotPackage (snapshot_id, nevra_id) ( - select distinct snapshot_id_v, nevra.id - from rhnServerPackage sp, rhnPackageNEVRA nevra - where sp.server_id = server_id_in - and nevra.name_id = sp.name_id - and nevra.evr_id = sp.evr_id - and (nevra.package_arch_id = sp.package_arch_id - or (nevra.package_arch_id is null - and sp.package_arch_id is null)) - ); - - insert into rhnSnapshotConfigChannel ( snapshot_id, config_channel_id ) ( - select snapshot_id_v, scc.config_channel_id - from rhnServerConfigChannel scc - where server_id = server_id_in - ); - - for revision in revisions loop - insert into rhnSnapshotConfigRevision ( - snapshot_id, config_revision_id - ) values ( - snapshot_id_v, revision.id - ); - end loop; - end$$ language plpgsql; - - create or replace function remove_action( - server_id_in in numeric, - action_id_in in numeric - ) returns void - as $$ - declare - -- this really wants "nulls last", but 8.1.7.3.0 sucks ass. - -- instead, we make a local table that holds our - -- list of ids with null prereqs. There's surely a better way - -- (an array instead of a table maybe? who knows...) - -- but I've got code to do this handy that I can look at ;) - chained_actions cursor is - with recursive r(id, prerequisite) as ( - select id, prerequisite - from rhnAction - where id = action_id_in - union all - select r1.id, r1.prerequisite - from rhnAction r1, r - where r.id = r1.prerequisite - ) - select * from r - order by prerequisite desc; - sessions cursor is - select s.id - from rhnKickstartSession s - where server_id_in in (s.old_server_id, s.new_server_id) - and s.action_id = action_id_in - and not exists ( - select 1 - from rhnKickstartSessionState ss - where ss.id = s.state_id - and ss.label in ('failed','complete') - ); - chain_ends numeric[]; - i numeric; - prereq numeric := 1; - begin - select prerequisite - into prereq - from rhnAction - where id = action_id_in; - - if prereq is not null then - perform rhn_exception.raise_exception('action_is_child'); - end if; - - chain_ends := '{}'; - i := 1; - for action in chained_actions loop - if action.prerequisite is null then - chain_ends[i] := action.id; - i := i + 1; - else - delete from rhnServerAction - where server_id = server_id_in - and action_id = action.id; - end if; - end loop; - - delete from rhnServerAction - where server_id = server_id_in - and action_id = any(chain_ends); - - for s in sessions loop - update rhnKickstartSession - set state_id = ( - select id - from rhnKickstartSessionState - where label = 'failed' - ), - action_id = null - where id = s.id; - perform set_ks_session_history_message(s.id, 'failed', 'Kickstart cancelled due to action removal'); - end loop; - end$$ language plpgsql; - - create or replace function check_user_access(server_id_in in numeric, user_id_in in numeric) - returns numeric - as $$ - declare - has_access numeric; - begin - -- first check; if this returns no rows, then the server/user are in different orgs, and we bail - select 1 into has_access - from rhnServer S, - web_contact wc - where wc.org_id = s.org_id - and s.id = server_id_in - and wc.id = user_id_in; - - if not found then - return 0; - end if; - - -- okay, so they're in the same org. if we have an org admin, they get a free pass - if rhn_user.check_role(user_id_in, 'org_admin') = 1 - then - return 1; - end if; - - select 1 into has_access - from rhnServerGroupMembers SGM, - rhnUserServerGroupPerms USG - where SGM.server_group_id = USG.server_group_id - and SGM.server_id = server_id_in - and USG.user_id = user_id_in; - - if not found then - return 0; - end if; - - return 1; - end$$ language plpgsql; - - -- ******************************************************************* - -- FUNCTION: can_server_consume_virt_slot - -- Returns 1 if the server id is eligible to consume a virtual slot, - -- else returns 0. - -- Called by: insert_into_servergroup, delete_from_servergroup - -- ******************************************************************* - create or replace function can_server_consume_virt_slot(server_id_in in numeric, - group_type_in in varchar) - returns numeric - as $$ - declare - server_virt_slots cursor is - select vi.VIRTUAL_SYSTEM_ID - from - rhnVirtualInstance vi - where - -- server id is a virtual instance - vi.VIRTUAL_SYSTEM_ID = server_id_in - -- server id's host is virt entitled - and exists ( select 1 - from rhnServerEntitlementView sev - where vi.HOST_SYSTEM_ID = sev.server_id - and sev.label in ('virtualization_host', - 'virtualization_host_platform') ) - -- server id's host also has the ent we want - and exists ( select 1 - from rhnServerEntitlementView sev2 - where vi.HOST_SYSTEM_ID = sev2.server_id - and sev2.label = group_type_in ); - - begin - for server_virt_slot in server_virt_slots loop - return 1; - end loop; - return 0; - end$$ language plpgsql; - - - create or replace function insert_into_servergroup ( - server_id_in in numeric, - server_group_id_in in numeric - ) returns void - as $$ - declare - used_slots numeric; - max_slots numeric; - org_id numeric; - mgmt_available numeric; - mgmt_upgrade numeric; - mgmt_sgid numeric; - prov_available numeric; - prov_upgrade numeric; - prov_sgid numeric; - group_label varchar; - group_type numeric; - begin - -- first, group_type = null, because it's easy... - - -- this will rowlock the servergroup we're trying to change; - -- we probably need to lock the other one, but I think the chances - -- of it being a real issue are very small for now... - select sg.group_type, sg.org_id, sg.current_members, sg.max_members - into group_type, org_id, used_slots, max_slots - from rhnServerGroup sg - where sg.id = server_group_id_in - for update of sg; - - if group_type is null then - if used_slots >= max_slots then - perform rhn_exception.raise_exception('servergroup_max_members'); - end if; - - insert into rhnServerGroupMembers( - server_id, server_group_id - ) values ( - server_id_in, server_group_id_in - ); - update rhnServerGroup - set current_members = current_members + 1 - where id = server_group_id_in; - - perform rhn_cache.update_perms_for_server_group(server_group_id_in); - return; - end if; - - -- now for group_type != null - -- - select label - into group_label - from rhnServerGroupType sgt - where sgt.id = group_type; - - -- the naive easy path that gets hit most often and has to be quickest. - if group_label in ('sw_mgr_entitled', - 'enterprise_entitled', - 'monitoring_entitled', - 'provisioning_entitled', - 'virtualization_host', - 'virtualization_host_platform') then - if used_slots >= max_slots and - (rhn_server.can_server_consume_virt_slot(server_id_in, group_label) != 1) - then - perform rhn_exception.raise_exception('servergroup_max_members'); - end if; - - insert into rhnServerGroupMembers( - server_id, server_group_id - ) values ( - server_id_in, server_group_id_in - ); - - -- Only update current members if the system in consuming a - -- physical slot. - if rhn_server.can_server_consume_virt_slot(server_id_in, group_label) = 0 then - update rhnServerGroup - set current_members = current_members + 1 - where id = server_group_id_in; - end if; - - return; - end if; - end$$ language plpgsql; - - create or replace function insert_into_servergroup_maybe ( - server_id_in in numeric, - server_group_id_in in numeric - ) returns numeric as $$ - declare - retval numeric := 0; - servergroups cursor is - select s.id server_id, - sg.id server_group_id - from rhnServerGroup sg, - rhnServer s - where s.id = server_id_in - and sg.id = server_group_id_in - and s.org_id = sg.org_id - and not exists ( - select 1 - from rhnServerGroupMembers sgm - where sgm.server_id = s.id - and sgm.server_group_id = sg.id - ); - begin - for sgm in servergroups loop - perform rhn_server.insert_into_servergroup(sgm.server_id, sgm.server_group_id); - retval := retval + 1; - end loop; - return retval; - end$$ language plpgsql; - - create or replace function insert_set_into_servergroup ( - server_group_id_in in numeric, - user_id_in in numeric, - set_label_in in varchar - ) returns void - as $$ - declare - servers cursor is - select st.element id - from rhnSet st - where st.user_id = user_id_in - and st.label = set_label_in - and exists ( - select 1 - from rhnUserManagedServerGroups umsg - where umsg.server_group_id = server_group_id_in - and umsg.user_id = user_id_in - ) - and not exists ( - select 1 - from rhnServerGroupMembers sgm - where sgm.server_id = st.element - and sgm.server_group_id = server_group_id_in - ); - begin - for s in servers loop - perform rhn_server.insert_into_servergroup(s.id, server_group_id_in); - end loop; - end$$ language plpgsql; - - create or replace function delete_from_servergroup ( - server_id_in in numeric, - server_group_id_in in numeric - ) returns void - as $$ - declare - server_virt_groups cursor is - select 1 - from rhnServerEntitlementVirtual sev - where sev.server_id = server_id_in - and sev.server_group_id = server_group_id_in; - - oid numeric; - mgmt_sgid numeric; - label varchar; - group_type numeric; - begin - select sg.group_type, sg.org_id - into group_type, oid - from rhnServerGroupMembers sgm, - rhnServerGroup sg - where sg.id = server_group_id_in - and sg.id = sgm.server_group_id - and sgm.server_id = server_id_in - for update of sg; - - if not found then - perform rhn_exception.raise_exception('server_not_in_group'); - end if; - - -- do group_type is null first - if group_type is null then - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - update rhnServerGroup - set current_members = current_members - 1 - where id = server_group_id_in; - perform rhn_cache.update_perms_for_server_group(server_group_id_in); - return; - end if; - - select sgt.label - into label - from rhnServerGroupType sgt - where sgt.id = group_type; - - if label in ('sw_mgr_entitled', - 'enterprise_entitled', - 'provisioning_entitled', - 'monitoring_entitled', - 'virtualization_host', - 'virtualization_host_platform') then - - -- Only update current members if the system is consuming - -- a physical slot. - for server_virt_group in server_virt_groups loop - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - return; - end loop; - - delete from rhnServerGroupMembers - where server_group_id = server_group_id_in - and server_id = server_id_in; - - update rhnServerGroup - set current_members = current_members - 1 - where id = server_group_id_in; - - end if; - end$$ language plpgsql; - - create or replace function delete_set_from_servergroup ( - server_group_id_in in numeric, - user_id_in in numeric, - set_label_in in varchar - ) returns void - as $$ - declare - servergroups cursor is - select sgm.server_id, sgm.server_group_id - from rhnSet st, - rhnServerGroupMembers sgm - where sgm.server_group_id = server_group_id_in - and st.user_id = user_id_in - and st.label = set_label_in - and sgm.server_id = st.element - and exists ( - select 1 - from rhnUserManagedServerGroups usgp - where usgp.server_group_id = server_group_id_in - and usgp.user_id = user_id_in - ); - begin - for sgm in servergroups loop - perform rhn_server.delete_from_servergroup(sgm.server_id, server_group_id_in); - end loop; - end$$ language plpgsql; - - create or replace function clear_servergroup ( - server_group_id_in in numeric - ) returns void - as $$ - declare - servers cursor is - select sgm.server_id id - from rhnServerGroupMembers sgm - where sgm.server_group_id = server_group_id_in; - begin - for s in servers loop - perform rhn_server.delete_from_servergroup(s.id, server_group_id_in); - end loop; - end$$ language plpgsql; - - create or replace function delete_from_org_servergroups ( - server_id_in in numeric - ) returns void - as $$ - declare - servergroups cursor is - select sgm.server_group_id id - from rhnServerGroup sg, - rhnServerGroupMembers sgm - where sgm.server_id = server_id_in - and sgm.server_group_id = sg.id - and sg.group_type is null; - begin - for sg in servergroups loop - perform rhn_server.delete_from_servergroup(server_id_in, sg.id); - end loop; - end$$ language plpgsql; - - create or replace function get_ip_address ( - server_id_in in numeric - ) returns varchar as $$ - declare - interfaces cursor is - select ni.name as name, na4.address as address - from rhnServerNetInterface ni, - rhnServerNetAddress4 na4 - where server_id = server_id_in - and ni.id = na4.interface_id - and na4.address != '127.0.0.1'; - addresses cursor is - select ipaddr ip_addr - from rhnServerNetwork - where server_id = server_id_in - and ipaddr != '127.0.0.1'; - begin - for addr in addresses loop - return addr.ip_addr; - end loop; - for iface in interfaces loop - return iface.address; - end loop; - return NULL; - end$$ language plpgsql; - - create or replace function update_needed_cache( - server_id_in in numeric - ) returns void as $$ - begin - delete from rhnServerNeededCache - where server_id = server_id_in; - insert into rhnServerNeededCache - (server_id, errata_id, package_id) - (select distinct server_id, errata_id, package_id - from rhnServerNeededView - where server_id = server_id_in); - end$$ language plpgsql; - --- restore the original setting -update pg_settings set setting = overlay( setting placing '' from 1 for (length('rhn_server')+1) ) where name = 'search_path'; commit 7dcc23a410119cd9d346a502e73b62536344a279 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:57:55 2011 +0200 Revert "get_hw_info_as_clob schema upgrade script" This reverts commit 5b060db239ed2f43106b7e16378c2cabd44e89f6. diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle deleted file mode 100644 index 819c4ca..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle +++ /dev/null @@ -1,33 +0,0 @@ - -create or replace function get_hw_info_as_clob( - sid in rhnserver.id%TYPE, - separator in varchar -) -return clob -is - ret clob; - tmp varchar2(4000); -begin - dbms_lob.createtemporary(ret, true); - for rec in ( - select m - from ( - select 1 n, sum(nrcpu) || ' CPUs' m - from rhncpu where rhncpu.server_id = sid - union all - select 2, ni.name||' '||na4.address||'/'||na4.netmask||' '||ni.hw_addr val - from rhnservernetinterface ni, - rhnServerNetAddress4 na4 - where ni.server_id = sid - and ni.id = na4.interface_id - ) - order by n, m - ) loop - if dbms_lob.getlength(ret) > 0 then - dbms_lob.writeappend(ret, length(separator), separator); - end if; - dbms_lob.writeappend(ret, length(rec.m), rec.m); - end loop; - return ret; -end; -/ diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql deleted file mode 100644 index 26ef11e..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql +++ /dev/null @@ -1,36 +0,0 @@ --- oracle equivalent source sha1 6a538f3b05d412810baec118fbb7860348c60cd4 - -create or replace function get_hw_info_as_clob( - sid in rhnserver.id%TYPE, - separator in varchar -) -returns text -as -$$ -declare - ret text; - rec record; -begin - for rec in ( - select m - from ( - select 1 n, sum(nrcpu) || ' CPUs' m - from rhncpu where rhncpu.server_id = sid - union all - select 2, ni.name||' '||coalesce(na4.address,'')||'/'||coalesce(na4.netmask,'')||' '||ni.hw_addr val - from rhnservernetinterface, - rhnServerNetAddress4 na4 - where ni.server_id = sid - and ni.id = na4.interface_id - ) X - order by n, m - ) loop - if ret is null then - ret := rec.m; - else - ret := ret || separator || rec.m; - end if; - end loop; - return ret; -end; -$$ language plpgsql; commit 2a8bb2a4e4a106a69d611664b1e018dcfc338f53 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:57:48 2011 +0200 Revert "code cleanup - tag rhn-server-network-interfaces is not used anywhere" This reverts commit 9cb74604757119a7702f1e50ea5a941cdd209698. diff --git a/web/modules/sniglets/Sniglets/Servers.pm b/web/modules/sniglets/Sniglets/Servers.pm index 270b9fa..1407073 100644 --- a/web/modules/sniglets/Sniglets/Servers.pm +++ b/web/modules/sniglets/Sniglets/Servers.pm @@ -61,6 +61,10 @@ sub register_tags { # has to run after server_details $pxt->register_tag('rhn-server-network-details' => \&server_network_details, 2); + # slightly different than the rhn-server-network-details, this gives access to + # more detailed info about the network interfaces, as opposed to just hostname/ipaddy + $pxt->register_tag('rhn-server-network-interfaces' => \&server_network_interfaces, 2); + $pxt->register_tag('rhn-server-history-event-details' => \&server_history_event_details); commit aa56e8ff2a499b98ae13af805e15991414b59a39 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:57:36 2011 +0200 Revert "code cleanup - function server_network_interfaces is not used anymore" This reverts commit 685cf4cc094cbfd72a77644010bb19393d012ae0. diff --git a/web/modules/sniglets/Sniglets/Servers.pm b/web/modules/sniglets/Sniglets/Servers.pm index 155a69b..270b9fa 100644 --- a/web/modules/sniglets/Sniglets/Servers.pm +++ b/web/modules/sniglets/Sniglets/Servers.pm @@ -690,6 +690,64 @@ sub server_network_details { return $ret; } + +sub server_network_interfaces { + my $pxt = shift; + my %params = @_; + my $ret = ''; + my $current; + + my $server = $pxt->pnotes('server'); + + throw "No server." unless $server; + + my @net_interfaces = $server->get_net_interfaces; + + my %subst; + + if (not @net_interfaces) { + return ''; + } + + PXT::Debug->log(7, "got net_interfaces..."); + + my $block = $params{__block__}; + $block =~ m/<rhn-interface-data>(.*?)<\/rhn-interface-data>/gism; + my $device_data_block = $1; + + + my $unknown = '(unknown)'; + my $html = ''; + my $counter = 1; + foreach my $interface (@net_interfaces) { + + my %subst; + if ($counter % 2) { + $subst{row_class} = 'list-row-odd'; + } + else { + $subst{row_class} = 'list-row-even'; + } + + + $subst{interface_name} = $interface->name; # NOT NULL + $subst{interface_ip_addr} = defined $interface->ip_addr ? PXT::Utils->escapeHTML($interface->ip_addr) : $unknown; + $subst{interface_netmask} = defined $interface->netmask ? PXT::Utils->escapeHTML($interface->netmask) : $unknown; + $subst{interface_broadcast} = defined $interface->broadcast ? PXT::Utils->escapeHTML($interface->broadcast) : $unknown; + $subst{interface_hw_addr} = defined $interface->hw_addr ? PXT::Utils->escapeHTML($interface->hw_addr) : $unknown; + $subst{interface_module} = defined $interface->module ? PXT::Utils->escapeHTML($interface->module) : $unknown; + + $html .= PXT::Utils->perform_substitutions($device_data_block, \%subst); + $counter++; + } + + PXT::Debug->log(7, "html: $html"); + + $block =~ s{<rhn-interface-data>.*?<\/rhn-interface-data>}{$html}ism; + + return $block; +} + # must happen *after* server_hardware_profile... so use tags # correctly! sub server_device { commit 7c2545a8a7956e20eef1d334ca80c7c3080f1e73 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:57:27 2011 +0200 Revert "code cleanup - function get_net_interfaces is not used anymore" This reverts commit 38b10e49fbc8d858997219ddaf5514ce81367783. diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm index 1eef958..36e5283 100644 --- a/web/modules/rhn/RHN/DB/Server.pm +++ b/web/modules/rhn/RHN/DB/Server.pm @@ -1383,6 +1383,14 @@ sub get_net_infos { return @net_infos; } +# returns an array of all the net info objects related to a server +sub get_net_interfaces { + my $self = shift; + + my @net_interfaces = RHN::DB::Server::NetInterface->lookup_net_interface_by_server($self->id); + return @net_interfaces; +} + # # build some accessors commit 2ea40592bf2e19a84dfc784eab195b62995ce843 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:57:12 2011 +0200 Revert "code cleanup - package RHN::DB::Server::NetInterface is not used anymore" This reverts commit f7ae084b3cb319fce99e38e776f68529f7439ebe. diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm index 22269cb..1eef958 100644 --- a/web/modules/rhn/RHN/DB/Server.pm +++ b/web/modules/rhn/RHN/DB/Server.pm @@ -25,6 +25,7 @@ use RHN::DB::Server::CdDevice; use RHN::DB::Server::HwDevice; use RHN::DB::Server::StorageDevice; use RHN::DB::Server::NetInfo; +use RHN::DB::Server::NetInterface; use RHN::DB::TableClass; use RHN::DataSource::Errata; diff --git a/web/modules/rhn/RHN/DB/Server/NetInterface.pm b/web/modules/rhn/RHN/DB/Server/NetInterface.pm new file mode 100644 index 0000000..238b75c --- /dev/null +++ b/web/modules/rhn/RHN/DB/Server/NetInterface.pm @@ -0,0 +1,86 @@ +# +# Copyright (c) 2008--2010 Red Hat, Inc. +# +# This software is licensed to you under the GNU General Public License, +# version 2 (GPLv2). There is NO WARRANTY for this software, express or +# implied, including the implied warranties of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +# along with this software; if not, see +# http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +# +# Red Hat trademarks are not licensed under GPLv2. No permission is +# granted to use or replicate Red Hat trademarks that are incorporated +# in this software or its documentation. +# + +use strict; + +package RHN::DB::Server::NetInterface; + +use RHN::DB; +use Carp; +use RHN::DB::TableClass; + +# Corresponds to an entry in the rhnServerNetInterface table... + +my @net_interface_fields = qw/SERVER_ID NAME IP_ADDR NETMASK BROADCAST HW_ADDR MODULE/; + +my $n = new RHN::DB::TableClass("rhnServerNetInterface", "N", "", @net_interface_fields); + +# create a blank net info object +sub _blank_net_interface { + my $class = shift; + + my $self = bless {}, $class; + + return $self; +} + +# returns an array of net info objects given a server id +sub lookup_net_interface_by_server { + my $class = shift; + my $server_id = shift; + + my $dbh = RHN::DB->connect; + + my $query; + my $sth; + + $query = $n->select_query("N.SERVER_ID = ?"); + $sth = $dbh->prepare($query); + $sth->execute($server_id); + + my @ret; + my $count = 0; + + while (my @columns = $sth->fetchrow) { + if ($columns[0]) { + $ret[$count] = $class->_blank_net_interface; + $ret[$count]->{"__".$_."__"} = shift @columns foreach $n->method_names; + } + $count++; + } + + $sth->finish; + return @ret; +} + +# build some read-only accessors +foreach my $field ($n->method_names) { + my $sub = q { + sub RHN::DB::Server::NetInterface::[[field]] { + my $self = shift; + return $self->{__[[field]]__}; + } + }; + + $sub =~ s/\[\[field\]\]/$field/g; + eval $sub; + + if ($@) { + die $@; + } +} + + +return 1; commit e5443ef04c88d56a385a527eaa3f54cf1f03ddee Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:56:34 2011 +0200 Revert "insert id from sequence using trigger" This reverts commit f2f453196dd56c106eb451d8a5c431c93a846ba4. diff --git a/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql b/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql index f31f4c4..da0bb65 100644 --- a/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql +++ b/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql @@ -19,9 +19,6 @@ rhn_srv_net_iface_mod_trig before insert or update on rhnServerNetInterface for each row begin - if :new.id is null then - select rhn_srv_net_iface_id_seq.nextval into :new.id from dual; - end if; :new.modified := sysdate; end; / diff --git a/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql b/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql index 192308f..349810c 100644 --- a/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql +++ b/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql @@ -1,10 +1,8 @@ --- oracle equivalent source sha1 1c9678fc0e82b0d0e1f659358120c971bc9bda20 +-- oracle equivalent source sha1 d37db54a176f593bd9727921ed20d00d6cd95f4b +-- retrieved from ./1241102873/cdc6d42049bf86fbc9f1d3a5c54275eeacbd641d/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql create or replace function rhn_srv_net_iface_mod_trig_fun() returns trigger as $$ begin - if new.id is null then - new.id := nextval('rhn_srv_net_iface_id_seq'); - end if; new.modified := current_timestamp; return new; end; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle deleted file mode 100644 index 1387bff..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle +++ /dev/null @@ -1,12 +0,0 @@ -create or replace trigger -rhn_srv_net_iface_mod_trig -before insert or update on rhnServerNetInterface -for each row -begin - if :new.id is null then - select rhn_srv_net_iface_id_seq.nextval into :new.id from dual; - end if; - :new.modified := sysdate; -end; -/ -show errors diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql deleted file mode 100644 index 588ece0..0000000 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql +++ /dev/null @@ -1,11 +0,0 @@ --- oracle equivalent source sha1 a3c3cb4940f2e96320a833521f352b83ddddaed1 -create or replace function rhn_srv_net_iface_mod_trig_fun() returns trigger as -$$ -begin - if new.id is null then - new.id := nextval('rhn_srv_net_iface_id_seq'); - end if; - new.modified := current_timestamp; - return new; -end; -$$ language plpgsql; commit d8aefa93800f54b18b990bb40076d05a8ead3505 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:56:18 2011 +0200 Revert "add oracle equivalent" This reverts commit 480c68154fce2eff3389b3e132fd28f96bc23859. diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql index 17fbb81..d103a65 100644 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql @@ -1,4 +1,3 @@ --- oracle equivalent source sha1 6e90408fc4c3d072bf407d0eb18962e46cb6a860 -- -- Copyright (c) 2008--2010 Red Hat, Inc. -- commit 26474e88d3cdc3ee3d833fcc78426bf562a7bac7 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:56:07 2011 +0200 Revert "__load_from_db: load devices using its method save()" This reverts commit 70694d0bccdccfc3f00ba4cfc0b3dd6b52e9cc3d. diff --git a/backend/server/rhnServer/server_hardware.py b/backend/server/rhnServer/server_hardware.py index 2b44250..dd044e1 100644 --- a/backend/server/rhnServer/server_hardware.py +++ b/backend/server/rhnServer/server_hardware.py @@ -703,13 +703,29 @@ class Hardware: self.__changed = 0 return 0 - def __load_from_db(self, DevClass, sysid): + def __load_from_db(self, db, DevClass, sysid): """ Load a certain hardware class from the database """ if not self.__hardware.has_key(DevClass): self.__hardware[DevClass] = [] - dev = DevClass() - dev.reload(sysid) - self.__hardware[DevClass].append(dev) + + h = rhnSQL.prepare("select * from %s where server_id = :sysid" % db) + h.execute(sysid = sysid) + rows = h.fetchall_dict() or [] + + for device in rows: + dev_id = device['id'] + + # get rid of the keys we do not support + for k in ["server_id", "created", "modified", "id"]: + if device.has_key(k): + del device[k] + dev = DevClass(device) + + # we know better + dev.id = dev_id + dev.status = 0 + self.__hardware[DevClass].append(dev) + return 0 def reload_hardware_byid(self, sysid): """ load all hardware devices for a server """ @@ -718,13 +734,18 @@ class Hardware: return -1 self.__hardware = {} # discard what was already loaded # load from all hardware databases - self.__load_from_db(HardwareDevice, sysid) - self.__load_from_db(CPUDevice, sysid) - self.__load_from_db(DMIInformation, sysid) - self.__load_from_db(NetworkInformation, sysid) - self.__load_from_db(MemoryInformation, sysid) - self.__load_from_db(InstallInformation, sysid) - self.__load_from_db(NetIfaceInformation, sysid) + self.__load_from_db("rhnDevice", HardwareDevice, sysid) + self.__load_from_db("rhnCPU", CPUDevice, sysid) + self.__load_from_db("rhnServerDMI", DMIInformation, sysid) + self.__load_from_db("rhnServerNetwork", NetworkInformation, sysid) + self.__load_from_db("rhnRAM", MemoryInformation, sysid) + self.__load_from_db("rhnServerInstallInfo", InstallInformation, sysid) + + net_iface_info = NetIfaceInformation() + net_iface_info.reload(sysid) + + self.__hardware[NetIfaceInformation] = [] + self.__hardware[NetIfaceInformation].append(net_iface_info) # now set the flag self.__changed = 0 commit 29544df9fb7d2c79db36b88548cee5f36f928d88 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 27 10:33:22 2011 +0200 742811 - domain_directory: R/O access to libvirtd is sufficient diff --git a/client/tools/rhn-virtualization/virtualization/domain_directory.py b/client/tools/rhn-virtualization/virtualization/domain_directory.py index ba069f4..6e438cc 100644 --- a/client/tools/rhn-virtualization/virtualization/domain_directory.py +++ b/client/tools/rhn-virtualization/virtualization/domain_directory.py @@ -67,7 +67,7 @@ class DomainDirectory: def __init__(self): self.__path = CONFIG_DIR - self.conn = libvirt.open(None) + self.conn = libvirt.openReadOnly(None) if not self.conn: raise VirtualizationException, \ "Failed to open connection to hypervisor." commit 70694d0bccdccfc3f00ba4cfc0b3dd6b52e9cc3d Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Tue Oct 25 16:33:51 2011 +0200 __load_from_db: load devices using its method save() this will put _auto_null and other stuff in game diff --git a/backend/server/rhnServer/server_hardware.py b/backend/server/rhnServer/server_hardware.py index dd044e1..2b44250 100644 --- a/backend/server/rhnServer/server_hardware.py +++ b/backend/server/rhnServer/server_hardware.py @@ -703,29 +703,13 @@ class Hardware: self.__changed = 0 return 0 - def __load_from_db(self, db, DevClass, sysid): + def __load_from_db(self, DevClass, sysid): """ Load a certain hardware class from the database """ if not self.__hardware.has_key(DevClass): self.__hardware[DevClass] = [] - - h = rhnSQL.prepare("select * from %s where server_id = :sysid" % db) - h.execute(sysid = sysid) - rows = h.fetchall_dict() or [] - - for device in rows: - dev_id = device['id'] - - # get rid of the keys we do not support - for k in ["server_id", "created", "modified", "id"]: - if device.has_key(k): - del device[k] - dev = DevClass(device) - - # we know better - dev.id = dev_id - dev.status = 0 - self.__hardware[DevClass].append(dev) - return 0 + dev = DevClass() + dev.reload(sysid) + self.__hardware[DevClass].append(dev) def reload_hardware_byid(self, sysid): """ load all hardware devices for a server """ @@ -734,18 +718,13 @@ class Hardware: return -1 self.__hardware = {} # discard what was already loaded # load from all hardware databases - self.__load_from_db("rhnDevice", HardwareDevice, sysid) - self.__load_from_db("rhnCPU", CPUDevice, sysid) - self.__load_from_db("rhnServerDMI", DMIInformation, sysid) - self.__load_from_db("rhnServerNetwork", NetworkInformation, sysid) - self.__load_from_db("rhnRAM", MemoryInformation, sysid) - self.__load_from_db("rhnServerInstallInfo", InstallInformation, sysid) - - net_iface_info = NetIfaceInformation() - net_iface_info.reload(sysid) - - self.__hardware[NetIfaceInformation] = [] - self.__hardware[NetIfaceInformation].append(net_iface_info) + self.__load_from_db(HardwareDevice, sysid) + self.__load_from_db(CPUDevice, sysid) + self.__load_from_db(DMIInformation, sysid) + self.__load_from_db(NetworkInformation, sysid) + self.__load_from_db(MemoryInformation, sysid) + self.__load_from_db(InstallInformation, sysid) + self.__load_from_db(NetIfaceInformation, sysid) # now set the flag self.__changed = 0 commit 480c68154fce2eff3389b3e132fd28f96bc23859 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Tue Oct 25 15:42:12 2011 +0200 add oracle equivalent diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql index d103a65..17fbb81 100644 --- a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql @@ -1,3 +1,4 @@ +-- oracle equivalent source sha1 6e90408fc4c3d072bf407d0eb18962e46cb6a860 -- -- Copyright (c) 2008--2010 Red Hat, Inc. -- commit f2f453196dd56c106eb451d8a5c431c93a846ba4 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 15:50:36 2011 +0200 insert id from sequence using trigger diff --git a/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql b/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql index da0bb65..f31f4c4 100644 --- a/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql +++ b/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql @@ -19,6 +19,9 @@ rhn_srv_net_iface_mod_trig before insert or update on rhnServerNetInterface for each row begin + if :new.id is null then + select rhn_srv_net_iface_id_seq.nextval into :new.id from dual; + end if; :new.modified := sysdate; end; / diff --git a/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql b/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql index 349810c..192308f 100644 --- a/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql +++ b/schema/spacewalk/postgres/triggers/rhnServerNetInterface.sql @@ -1,8 +1,10 @@ --- oracle equivalent source sha1 d37db54a176f593bd9727921ed20d00d6cd95f4b --- retrieved from ./1241102873/cdc6d42049bf86fbc9f1d3a5c54275eeacbd641d/schema/spacewalk/oracle/triggers/rhnServerNetInterface.sql +-- oracle equivalent source sha1 1c9678fc0e82b0d0e1f659358120c971bc9bda20 create or replace function rhn_srv_net_iface_mod_trig_fun() returns trigger as $$ begin + if new.id is null then + new.id := nextval('rhn_srv_net_iface_id_seq'); + end if; new.modified := current_timestamp; return new; end; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle new file mode 100644 index 0000000..1387bff --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.oracle @@ -0,0 +1,12 @@ +create or replace trigger +rhn_srv_net_iface_mod_trig +before insert or update on rhnServerNetInterface +for each row +begin + if :new.id is null then + select rhn_srv_net_iface_id_seq.nextval into :new.id from dual; + end if; + :new.modified := sysdate; +end; +/ +show errors diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql new file mode 100644 index 0000000..588ece0 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/123-trigger-rhnServerNetInterface.sql.postgresql @@ -0,0 +1,11 @@ +-- oracle equivalent source sha1 a3c3cb4940f2e96320a833521f352b83ddddaed1 +create or replace function rhn_srv_net_iface_mod_trig_fun() returns trigger as +$$ +begin + if new.id is null then + new.id := nextval('rhn_srv_net_iface_id_seq'); + end if; + new.modified := current_timestamp; + return new; +end; +$$ language plpgsql; commit f7ae084b3cb319fce99e38e776f68529f7439ebe Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 11:07:54 2011 +0200 code cleanup - package RHN::DB::Server::NetInterface is not used anymore diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm index 1eef958..22269cb 100644 --- a/web/modules/rhn/RHN/DB/Server.pm +++ b/web/modules/rhn/RHN/DB/Server.pm @@ -25,7 +25,6 @@ use RHN::DB::Server::CdDevice; use RHN::DB::Server::HwDevice; use RHN::DB::Server::StorageDevice; use RHN::DB::Server::NetInfo; -use RHN::DB::Server::NetInterface; use RHN::DB::TableClass; use RHN::DataSource::Errata; diff --git a/web/modules/rhn/RHN/DB/Server/NetInterface.pm b/web/modules/rhn/RHN/DB/Server/NetInterface.pm deleted file mode 100644 index 238b75c..0000000 --- a/web/modules/rhn/RHN/DB/Server/NetInterface.pm +++ /dev/null @@ -1,86 +0,0 @@ -# -# Copyright (c) 2008--2010 Red Hat, Inc. -# -# This software is licensed to you under the GNU General Public License, -# version 2 (GPLv2). There is NO WARRANTY for this software, express or -# implied, including the implied warranties of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 -# along with this software; if not, see -# http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. -# -# Red Hat trademarks are not licensed under GPLv2. No permission is -# granted to use or replicate Red Hat trademarks that are incorporated -# in this software or its documentation. -# - -use strict; - -package RHN::DB::Server::NetInterface; - -use RHN::DB; -use Carp; -use RHN::DB::TableClass; - -# Corresponds to an entry in the rhnServerNetInterface table... - -my @net_interface_fields = qw/SERVER_ID NAME IP_ADDR NETMASK BROADCAST HW_ADDR MODULE/; - -my $n = new RHN::DB::TableClass("rhnServerNetInterface", "N", "", @net_interface_fields); - -# create a blank net info object -sub _blank_net_interface { - my $class = shift; - - my $self = bless {}, $class; - - return $self; -} - -# returns an array of net info objects given a server id -sub lookup_net_interface_by_server { - my $class = shift; - my $server_id = shift; - - my $dbh = RHN::DB->connect; - - my $query; - my $sth; - - $query = $n->select_query("N.SERVER_ID = ?"); - $sth = $dbh->prepare($query); - $sth->execute($server_id); - - my @ret; - my $count = 0; - - while (my @columns = $sth->fetchrow) { - if ($columns[0]) { - $ret[$count] = $class->_blank_net_interface; - $ret[$count]->{"__".$_."__"} = shift @columns foreach $n->method_names; - } - $count++; - } - - $sth->finish; - return @ret; -} - -# build some read-only accessors -foreach my $field ($n->method_names) { - my $sub = q { - sub RHN::DB::Server::NetInterface::[[field]] { - my $self = shift; - return $self->{__[[field]]__}; - } - }; - - $sub =~ s/\[\[field\]\]/$field/g; - eval $sub; - - if ($@) { - die $@; - } -} - - -return 1; commit 38b10e49fbc8d858997219ddaf5514ce81367783 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 11:06:33 2011 +0200 code cleanup - function get_net_interfaces is not used anymore diff --git a/web/modules/rhn/RHN/DB/Server.pm b/web/modules/rhn/RHN/DB/Server.pm index 36e5283..1eef958 100644 --- a/web/modules/rhn/RHN/DB/Server.pm +++ b/web/modules/rhn/RHN/DB/Server.pm @@ -1383,14 +1383,6 @@ sub get_net_infos { return @net_infos; } -# returns an array of all the net info objects related to a server -sub get_net_interfaces { - my $self = shift; - - my @net_interfaces = RHN::DB::Server::NetInterface->lookup_net_interface_by_server($self->id); - return @net_interfaces; -} - # # build some accessors commit 685cf4cc094cbfd72a77644010bb19393d012ae0 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 11:05:47 2011 +0200 code cleanup - function server_network_interfaces is not used anymore diff --git a/web/modules/sniglets/Sniglets/Servers.pm b/web/modules/sniglets/Sniglets/Servers.pm index 270b9fa..155a69b 100644 --- a/web/modules/sniglets/Sniglets/Servers.pm +++ b/web/modules/sniglets/Sniglets/Servers.pm @@ -690,64 +690,6 @@ sub server_network_details { return $ret; } - -sub server_network_interfaces { - my $pxt = shift; - my %params = @_; - my $ret = ''; - my $current; - - my $server = $pxt->pnotes('server'); - - throw "No server." unless $server; - - my @net_interfaces = $server->get_net_interfaces; - - my %subst; - - if (not @net_interfaces) { - return ''; - } - - PXT::Debug->log(7, "got net_interfaces..."); - - my $block = $params{__block__}; - $block =~ m/<rhn-interface-data>(.*?)<\/rhn-interface-data>/gism; - my $device_data_block = $1; - - - my $unknown = '(unknown)'; - my $html = ''; - my $counter = 1; - foreach my $interface (@net_interfaces) { - - my %subst; - if ($counter % 2) { - $subst{row_class} = 'list-row-odd'; - } - else { - $subst{row_class} = 'list-row-even'; - } - - - $subst{interface_name} = $interface->name; # NOT NULL - $subst{interface_ip_addr} = defined $interface->ip_addr ? PXT::Utils->escapeHTML($interface->ip_addr) : $unknown; - $subst{interface_netmask} = defined $interface->netmask ? PXT::Utils->escapeHTML($interface->netmask) : $unknown; - $subst{interface_broadcast} = defined $interface->broadcast ? PXT::Utils->escapeHTML($interface->broadcast) : $unknown; - $subst{interface_hw_addr} = defined $interface->hw_addr ? PXT::Utils->escapeHTML($interface->hw_addr) : $unknown; - $subst{interface_module} = defined $interface->module ? PXT::Utils->escapeHTML($interface->module) : $unknown; - - $html .= PXT::Utils->perform_substitutions($device_data_block, \%subst); - $counter++; - } - - PXT::Debug->log(7, "html: $html"); - - $block =~ s{<rhn-interface-data>.*?<\/rhn-interface-data>}{$html}ism; - - return $block; -} - # must happen *after* server_hardware_profile... so use tags # correctly! sub server_device { commit 9cb74604757119a7702f1e50ea5a941cdd209698 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 11:04:27 2011 +0200 code cleanup - tag rhn-server-network-interfaces is not used anywhere diff --git a/web/modules/sniglets/Sniglets/Servers.pm b/web/modules/sniglets/Sniglets/Servers.pm index 1407073..270b9fa 100644 --- a/web/modules/sniglets/Sniglets/Servers.pm +++ b/web/modules/sniglets/Sniglets/Servers.pm @@ -61,10 +61,6 @@ sub register_tags { # has to run after server_details $pxt->register_tag('rhn-server-network-details' => \&server_network_details, 2); - # slightly different than the rhn-server-network-details, this gives access to - # more detailed info about the network interfaces, as opposed to just hostname/ipaddy - $pxt->register_tag('rhn-server-network-interfaces' => \&server_network_interfaces, 2); - $pxt->register_tag('rhn-server-history-event-details' => \&server_history_event_details); commit 5b060db239ed2f43106b7e16378c2cabd44e89f6 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Fri Oct 21 10:03:49 2011 +0200 get_hw_info_as_clob schema upgrade script diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle new file mode 100644 index 0000000..819c4ca --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.oracle @@ -0,0 +1,33 @@ + +create or replace function get_hw_info_as_clob( + sid in rhnserver.id%TYPE, + separator in varchar +) +return clob +is + ret clob; + tmp varchar2(4000); +begin + dbms_lob.createtemporary(ret, true); + for rec in ( + select m + from ( + select 1 n, sum(nrcpu) || ' CPUs' m + from rhncpu where rhncpu.server_id = sid + union all + select 2, ni.name||' '||na4.address||'/'||na4.netmask||' '||ni.hw_addr val + from rhnservernetinterface ni, + rhnServerNetAddress4 na4 + where ni.server_id = sid + and ni.id = na4.interface_id + ) + order by n, m + ) loop + if dbms_lob.getlength(ret) > 0 then + dbms_lob.writeappend(ret, length(separator), separator); + end if; + dbms_lob.writeappend(ret, length(rec.m), rec.m); + end loop; + return ret; +end; +/ diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql new file mode 100644 index 0000000..26ef11e --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/122-get_hw_info_as_clob.sql.postgresql @@ -0,0 +1,36 @@ +-- oracle equivalent source sha1 6a538f3b05d412810baec118fbb7860348c60cd4 + +create or replace function get_hw_info_as_clob( + sid in rhnserver.id%TYPE, + separator in varchar +) +returns text +as +$$ +declare + ret text; + rec record; +begin + for rec in ( + select m + from ( + select 1 n, sum(nrcpu) || ' CPUs' m + from rhncpu where rhncpu.server_id = sid + union all + select 2, ni.name||' '||coalesce(na4.address,'')||'/'||coalesce(na4.netmask,'')||' '||ni.hw_addr val + from rhnservernetinterface, + rhnServerNetAddress4 na4 + where ni.server_id = sid + and ni.id = na4.interface_id + ) X + order by n, m + ) loop + if ret is null then + ret := rec.m; + else + ret := ret || separator || rec.m; + end if; + end loop; + return ret; +end; +$$ language plpgsql; commit aa6a12287e103d424ebf882cf0dc003ea9c93e91 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Fri Oct 21 10:03:03 2011 +0200 upgrade script for rhn_server.pkb diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle new file mode 100644 index 0000000..87600df --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.oracle @@ -0,0 +1,750 @@ +-- +-- Copyright (c) 2008--2010 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- +-- +-- +-- + +create or replace +package body rhn_server +is + function system_service_level( + server_id_in in number, + service_level_in in varchar2 + ) return number is + + cursor ents is + select label from rhnServerEntitlementView + where server_id = server_id_in; + + retval number := 0; + + begin + for ent in ents loop + retval := rhn_entitlements.entitlement_grants_service (ent.label, service_level_in); + if retval = 1 then + return retval; + end if; + end loop; + + return retval; + + end system_service_level; + + + function can_change_base_channel(server_id_in IN NUMBER) + return number + is + throwaway number; + begin + -- the idea: if we get past this query, the server is + -- neither sat nor proxy, so base channel is changeable + + select 1 into throwaway + from rhnServer S + where S.id = server_id_in + and not exists (select 1 from rhnSatelliteInfo SI where SI.server_id = S.id) + and not exists (select 1 from rhnProxyInfo PI where PI.server_id = S.id); + + return 1; + exception + when no_data_found + then + return 0; + end can_change_base_channel; + + procedure set_custom_value( + server_id_in in number, + user_id_in in number, + key_label_in in varchar2, + value_in in varchar2 + ) is + key_id_val number; + begin + select CDK.id into key_id_val + from rhnCustomDataKey CDK, + rhnServer S + where S.id = server_id_in + and S.org_id = CDK.org_id + and CDK.label = key_label_in; + + begin + insert into rhnServerCustomDataValue (server_id, key_id, value, created_by, last_modified_by) + values (server_id_in, key_id_val, value_in, user_id_in, user_id_in); + exception + when DUP_VAL_ON_INDEX + then + update rhnServerCustomDataValue + set value = value_in, + last_modified_by = user_id_in + where server_id = server_id_in + and key_id = key_id_val; + end; + + end set_custom_value; + + function bulk_set_custom_value( + key_label_in in varchar2, + value_in in varchar2, + set_label_in in varchar2, + set_uid_in in number + ) + return integer + is + i integer := 0; + begin + i := 0; + for server in rhn_set.set_iterator(set_label_in, set_uid_in) + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + rhn_server.set_custom_value(server.element, set_uid_in, key_label_in, value_in); + i := i + 1; + end if; + end loop server; + return i; + end bulk_set_custom_value; + + procedure bulk_snapshot_tag( + org_id_in in number, + tagname_in in varchar2, + set_label_in in varchar2, + set_uid_in in number + ) is + snapshot_id number; + begin + for server in rhn_set.set_iterator(set_label_in, set_uid_in) + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + begin + select max(id) into snapshot_id + from rhnSnapshot + where server_id = server.element; + exception + when NO_DATA_FOUND then + rhn_server.snapshot_server(server.element, 'tagging system: ' || tagname_in); + + select max(id) into snapshot_id + from rhnSnapshot + where server_id = server.element; + end; + + -- now have a snapshot_id to work with... + begin + rhn_server.tag_snapshot(snapshot_id, org_id_in, tagname_in); + exception + when DUP_VAL_ON_INDEX + then + -- do nothing, be forgiving... + null; + end; + end if; + end loop server; + end bulk_snapshot_tag; + + procedure tag_delete( + server_id_in in number, + tag_id_in in number + ) is + cursor snapshots is + select snapshot_id + from rhnSnapshotTag + where tag_id = tag_id_in; + tag_id_tmp number; + begin + select id into tag_id_tmp + from rhnTag + where id = tag_id_in + for update; + + delete + from rhnSnapshotTag + where server_id = server_id_in + and tag_id = tag_id_in; + for snapshot in snapshots loop + return; + end loop; + delete + from rhnTag + where id = tag_id_in; + end tag_delete; + + procedure tag_snapshot( + snapshot_id_in in number, + org_id_in in number, + tagname_in in varchar2 + ) is + begin + insert into rhnSnapshotTag (snapshot_id, server_id, tag_id) + select snapshot_id_in, server_id, lookup_tag(org_id_in, tagname_in) + from rhnSnapshot + where id = snapshot_id_in; + end tag_snapshot; + + procedure bulk_snapshot( + reason_in in varchar2, + set_label_in in varchar2, + set_uid_in in number + ) is + begin + for server in rhn_set.set_iterator(set_label_in, set_uid_in) + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + rhn_server.snapshot_server(server.element, reason_in); + end if; + end loop server; + end bulk_snapshot; + + procedure snapshot_server( + server_id_in in number, + reason_in in varchar2 + ) is + snapshot_id number; + cursor revisions is + select distinct + cr.id + from rhnConfigRevision cr, + rhnConfigFileName cfn, + rhnConfigFile cf, + rhnConfigChannel cc, + rhnServerConfigChannel scc + where 1=1 + and scc.server_id = server_id_in + and scc.config_channel_id = cc.id + and cc.id = cf.config_channel_id + and cf.id = cr.config_file_id + and cr.id = cf.latest_config_revision_id + and cf.config_file_name_id = cfn.id + and cf.id = lookup_first_matching_cf(scc.server_id, cfn.path); + locked integer; + begin + select rhn_snapshot_id_seq.nextval into snapshot_id from dual; + + insert into rhnSnapshot (id, org_id, server_id, reason) ( + select snapshot_id, + s.org_id, + server_id_in, + reason_in + from rhnServer s + where s.id = server_id_in + ); + insert into rhnSnapshotChannel (snapshot_id, channel_id) ( + select snapshot_id, sc.channel_id + from rhnServerChannel sc + where sc.server_id = server_id_in + ); + insert into rhnSnapshotServerGroup (snapshot_id, server_group_id) ( + select snapshot_id, sgm.server_group_id + from rhnServerGroupMembers sgm + where sgm.server_id = server_id_in + ); + locked := 0; + while true loop + begin + insert into rhnPackageNEVRA (id, name_id, evr_id, package_arch_id) + select rhn_pkgnevra_id_seq.nextval, sp.name_id, sp.evr_id, sp.package_arch_id + from rhnServerPackage sp + where sp.server_id = server_id_in + and not exists + (select 1 + from rhnPackageNEVRA nevra + where nevra.name_id = sp.name_id + and nevra.evr_id = sp.evr_id + and (nevra.package_arch_id = sp.package_arch_id + or (nevra.package_arch_id is null + and sp.package_arch_id is null))); + exit; + exception when dup_val_on_index then + if locked = 1 then + raise; + else + lock table rhnPackageNEVRA in exclusive mode; + locked := 1; + end if; + end; + end loop; + insert into rhnSnapshotPackage (snapshot_id, nevra_id) ( + select distinct snapshot_id, nevra.id + from rhnServerPackage sp, rhnPackageNEVRA nevra + where sp.server_id = server_id_in + and nevra.name_id = sp.name_id + and nevra.evr_id = sp.evr_id + and (nevra.package_arch_id = sp.package_arch_id + or (nevra.package_arch_id is null + and sp.package_arch_id is null)) + ); + + insert into rhnSnapshotConfigChannel ( snapshot_id, config_channel_id ) ( + select snapshot_id, scc.config_channel_id + from rhnServerConfigChannel scc + where server_id = server_id_in + ); + + for revision in revisions loop + insert into rhnSnapshotConfigRevision ( + snapshot_id, config_revision_id + ) values ( + snapshot_id, revision.id + ); + end loop; + end snapshot_server; + + procedure remove_action( + server_id_in in number, + action_id_in in number + ) is + -- this really wants "nulls last", but 8.1.7.3.0 sucks ass. + -- instead, we make a local table that holds our + -- list of ids with null prereqs. There's surely a better way + -- (an array instead of a table maybe? who knows...) + -- but I've got code to do this handy that I can look at ;) + cursor chained_actions is + select id, prerequisite + from rhnAction + start with id = action_id_in + connect by prior id = prerequisite + order by prerequisite desc; + cursor sessions is + select s.id + from rhnKickstartSession s + where server_id_in in (s.old_server_id, s.new_server_id) + and s.action_id = action_id_in + and not exists ( + select 1 + from rhnKickstartSessionState ss + where ss.id = s.state_id + and ss.label in ('failed','complete') + ); + type chain_end_type is table of number index by binary_integer; + chain_ends chain_end_type; + i number; + prereq number := 1; + begin + select prerequisite + into prereq + from rhnAction + where id = action_id_in; + + if prereq is not null then + rhn_exception.raise_exception('action_is_child'); + end if; + + i := 0; + for action in chained_actions loop + if action.prerequisite is null then + chain_ends(i) := action.id; + i := i + 1; + else + delete from rhnServerAction + where server_id = server_id_in + and action_id = action.id; + end if; + end loop; + i := chain_ends.first; + while i is not null loop + delete from rhnServerAction + where server_id = server_id_in + and action_id = chain_ends(i); + i := chain_ends.next(i); + end loop; + for s in sessions loop + update rhnKickstartSession + set state_id = ( + select id + from rhnKickstartSessionState + where label = 'failed' + ), + action_id = null + where id = s.id; + set_ks_session_history_message(s.id, 'failed', 'Kickstart cancelled due to action removal'); + end loop; + end remove_action; + + function check_user_access(server_id_in in number, user_id_in in number) + return number + is + has_access number; + begin + -- first check; if this returns no rows, then the server/user are in different orgs, and we bail + select 1 into has_access + from rhnServer S, + web_contact wc + where wc.org_id = s.org_id + and s.id = server_id_in + and wc.id = user_id_in; + + -- okay, so they're in the same org. if we have an org admin, they get a free pass + if rhn_user.check_role(user_id_in, 'org_admin') = 1 + then + return 1; + end if; + + select 1 into has_access + from rhnServerGroupMembers SGM, + rhnUserServerGroupPerms USG + where SGM.server_group_id = USG.server_group_id + and SGM.server_id = server_id_in + and USG.user_id = user_id_in + and rownum = 1; + + return 1; + exception + when no_data_found + then + return 0; + end check_user_access; + + -- ******************************************************************* + -- FUNCTION: can_server_consume_virt_slot + -- Returns 1 if the server id is eligible to consume a virtual slot, + -- else returns 0. + -- Called by: insert_into_servergroup, delete_from_servergroup + -- ******************************************************************* + function can_server_consume_virt_slot(server_id_in in number, + group_type_in in + rhnServerGroupType.label%TYPE) + return number + is + + cursor server_virt_slots is + select vi.VIRTUAL_SYSTEM_ID + from + rhnVirtualInstance vi + where + -- server id is a virtual instance + vi.VIRTUAL_SYSTEM_ID = server_id_in + -- server id's host is virt entitled + and exists ( select 1 + from rhnServerEntitlementView sev + where vi.HOST_SYSTEM_ID = sev.server_id + and sev.label in ('virtualization_host', + 'virtualization_host_platform') ) + -- server id's host also has the ent we want + and exists ( select 1 + from rhnServerEntitlementView sev2 + where vi.HOST_SYSTEM_ID = sev2.server_id + and sev2.label = group_type_in ); + + begin + for server_virt_slot in server_virt_slots loop + return 1; + end loop; + return 0; + end can_server_consume_virt_slot; + + + procedure insert_into_servergroup ( + server_id_in in number, + server_group_id_in in number + ) is + used_slots number; + max_slots number; + org_id number; + mgmt_available number; + mgmt_upgrade number; + mgmt_sgid number; + prov_available number; + prov_upgrade number; + prov_sgid number; + group_label rhnServerGroupType.label%TYPE; + group_type number; + begin + -- frist, group_type = null, because it's easy... + + -- this will rowlock the servergroup we're trying to change; + -- we probably need to lock the other one, but I think the chances + -- of it being a real issue are very small for now... + select sg.group_type, sg.org_id, sg.current_members, sg.max_members + into group_type, org_id, used_slots, max_slots + from rhnServerGroup sg + where sg.id = server_group_id_in + for update of sg.current_members; + + if group_type is null then + if used_slots >= max_slots then + rhn_exception.raise_exception('servergroup_max_members'); + end if; + + insert into rhnServerGroupMembers( + server_id, server_group_id + ) values ( + server_id_in, server_group_id_in + ); + update rhnServerGroup + set current_members = current_members + 1 + where id = server_group_id_in; + + rhn_cache.update_perms_for_server_group(server_group_id_in); + return; + end if; + + -- now for group_type != null + -- + select label + into group_label + from rhnServerGroupType sgt + where sgt.id = group_type; + + -- the naive easy path that gets hit most often and has to be quickest. + if group_label in ('sw_mgr_entitled', + 'enterprise_entitled', + 'monitoring_entitled', + 'provisioning_entitled', + 'virtualization_host', + 'virtualization_host_platform') then + if used_slots >= max_slots and + (can_server_consume_virt_slot(server_id_in, group_label) != 1) + then + rhn_exception.raise_exception('servergroup_max_members'); + end if; + + insert into rhnServerGroupMembers( + server_id, server_group_id + ) values ( + server_id_in, server_group_id_in + ); + + -- Only update current members if the system in consuming a + -- physical slot. + if can_server_consume_virt_slot(server_id_in, group_label) = 0 then + update rhnServerGroup + set current_members = current_members + 1 + where id = server_group_id_in; + end if; + + return; + end if; + end; + + function insert_into_servergroup_maybe ( + server_id_in in number, + server_group_id_in in number + ) return number is + retval number := 0; + cursor servergroups is + select s.id server_id, + sg.id server_group_id + from rhnServerGroup sg, + rhnServer s + where s.id = server_id_in + and sg.id = server_group_id_in + and s.org_id = sg.org_id + and not exists ( + select 1 + from rhnServerGroupMembers sgm + where sgm.server_id = s.id + and sgm.server_group_id = sg.id + ); + begin + for sgm in servergroups loop + rhn_server.insert_into_servergroup(sgm.server_id, sgm.server_group_id); + retval := retval + 1; + end loop; + return retval; + end insert_into_servergroup_maybe; + + procedure insert_set_into_servergroup ( + server_group_id_in in number, + user_id_in in number, + set_label_in in varchar2 + ) is + cursor servers is + select st.element id + from rhnSet st + where st.user_id = user_id_in + and st.label = set_label_in + and exists ( + select 1 + from rhnUserManagedServerGroups umsg + where umsg.server_group_id = server_group_id_in + and umsg.user_id = user_id_in + ) + and not exists ( + select 1 + from rhnServerGroupMembers sgm + where sgm.server_id = st.element + and sgm.server_group_id = server_group_id_in + ); + begin + for s in servers loop + rhn_server.insert_into_servergroup(s.id, server_group_id_in); + end loop; + end insert_set_into_servergroup; + + procedure delete_from_servergroup ( + server_id_in in number, + server_group_id_in in number + ) is + cursor server_virt_groups is + select 1 + from rhnServerEntitlementVirtual sev + where sev.server_id = server_id_in + and sev.server_group_id = server_group_id_in; + + oid number; + mgmt_sgid number; + label rhnServerGroupType.label%TYPE; + group_type number; + begin + begin + select sg.group_type, sg.org_id + into group_type, oid + from rhnServerGroupMembers sgm, + rhnServerGroup sg + where sg.id = server_group_id_in + and sg.id = sgm.server_group_id + and sgm.server_id = server_id_in + for update of sg.current_members; + exception + when no_data_found then + rhn_exception.raise_exception('server_not_in_group'); + end; + + -- do group_type is null first + if group_type is null then + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + update rhnServerGroup + set current_members = current_members - 1 + where id = server_group_id_in; + rhn_cache.update_perms_for_server_group(server_group_id_in); + return; + end if; + + select sgt.label + into label + from rhnServerGroupType sgt + where sgt.id = group_type; + + if label in ('sw_mgr_entitled', + 'enterprise_entitled', + 'provisioning_entitled', + 'monitoring_entitled', + 'virtualization_host', + 'virtualization_host_platform') then + + -- Only update current members if the system is consuming + -- a physical slot. + for server_virt_group in server_virt_groups loop + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + return; + end loop; + + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + + update rhnServerGroup + set current_members = current_members - 1 + where id = server_group_id_in; + + end if; + end; + + procedure delete_set_from_servergroup ( + server_group_id_in in number, + user_id_in in number, + set_label_in in varchar2 + ) is + cursor servergroups is + select sgm.server_id, sgm.server_group_id + from rhnSet st, + rhnServerGroupMembers sgm + where sgm.server_group_id = server_group_id_in + and st.user_id = user_id_in + and st.label = set_label_in + and sgm.server_id = st.element + and exists ( + select 1 + from rhnUserManagedServerGroups usgp + where usgp.server_group_id = server_group_id_in + and usgp.user_id = user_id_in + ); + begin + for sgm in servergroups loop + rhn_server.delete_from_servergroup(sgm.server_id, server_group_id_in); + end loop; + end delete_set_from_servergroup; + + procedure clear_servergroup ( + server_group_id_in in number + ) is + cursor servers is + select sgm.server_id id + from rhnServerGroupMembers sgm + where sgm.server_group_id = server_group_id_in; + begin + for s in servers loop + rhn_server.delete_from_servergroup(s.id, server_group_id_in); + end loop; + end clear_servergroup; + + procedure delete_from_org_servergroups ( + server_id_in in number + ) is + cursor servergroups is + select sgm.server_group_id id + from rhnServerGroup sg, + rhnServerGroupMembers sgm + where sgm.server_id = server_id_in + and sgm.server_group_id = sg.id + and sg.group_type is null; + begin + for sg in servergroups loop + rhn_server.delete_from_servergroup(server_id_in, sg.id); + end loop; + end delete_from_org_servergroups; + + function get_ip_address ( + server_id_in in number + ) return varchar2 is + cursor interfaces is + select ni.name as name, na4.address as address + from rhnServerNetInterface ni, + rhnServerNetAddress4 na4 + where ni.server_id = server_id_in + and ni.id = na4.interface_id + and na4.address != '127.0.0.1'; + cursor addresses is + select ipaddr ip_addr + from rhnServerNetwork + where server_id = server_id_in + and ipaddr != '127.0.0.1'; + begin + for addr in addresses loop + return addr.ip_addr; + end loop; + for iface in interfaces loop + return iface.address; + end loop; + return NULL; + end get_ip_address; + + procedure update_needed_cache(server_id_in in number) + is + begin + delete from rhnServerNeededCache + where server_id = server_id_in; + insert into rhnServerNeededCache + (server_id, errata_id, package_id) + (select distinct server_id, errata_id, package_id + from rhnServerNeededView + where server_id = server_id_in); + end update_needed_cache; + +end rhn_server; +/ +SHOW ERRORS diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql new file mode 100644 index 0000000..d103a65 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/121-rhn_server-get_ip_address.sql.postgresql @@ -0,0 +1,802 @@ +-- +-- Copyright (c) 2008--2010 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- +-- +-- +-- + +create schema rhn_server; + +--update pg_setting +update pg_settings set setting = 'rhn_server,' || setting where name = 'search_path'; + + create or replace function system_service_level( + server_id_in in numeric, + service_level_in in varchar + ) returns numeric as $$ + declare + ents cursor is + select label from rhnServerEntitlementView + where server_id = server_id_in; + + retval numeric := 0; + + begin + for ent in ents loop + retval := rhn_entitlements.entitlement_grants_service (ent.label, service_level_in); + if retval = 1 then + return retval; + end if; + end loop; + + return retval; + + end$$ language plpgsql; + + + create or replace function can_change_base_channel(server_id_in IN NUMERIC) + returns numeric + as $$ + declare + throwaway numeric; + begin + -- the idea: if we get past this query, the server is + -- neither sat nor proxy, so base channel is changeable + + select 1 into throwaway + from rhnServer S + where S.id = server_id_in + and not exists (select 1 from rhnSatelliteInfo SI where SI.server_id = S.id) + and not exists (select 1 from rhnProxyInfo PI where PI.server_id = S.id); + + if not found then + return 0; + end if; + + return 1; + end$$ language plpgsql; + + create or replace function set_custom_value( + server_id_in in numeric, + user_id_in in numeric, + key_label_in in varchar, + value_in in varchar + ) returns void + as $$ + declare + key_id_val numeric; + begin + select CDK.id into strict key_id_val + from rhnCustomDataKey CDK, + rhnServer S + where S.id = server_id_in + and S.org_id = CDK.org_id + and CDK.label = key_label_in; + + begin + insert into rhnServerCustomDataValue (server_id, key_id, value, created_by, last_modified_by) + values (server_id_in, key_id_val, value_in, user_id_in, user_id_in); + exception + when UNIQUE_VIOLATION + then + update rhnServerCustomDataValue + set value = value_in, + last_modified_by = user_id_in + where server_id = server_id_in + and key_id = key_id_val; + end; + + end$$ language plpgsql; + + create or replace function bulk_set_custom_value( + key_label_in in varchar, + value_in in varchar, + set_label_in in varchar, + set_uid_in in numeric + ) + returns integer + as $$ + declare + i integer; + server record; + begin + i := 0; + for server in + SELECT user_id, label, element, element_two + FROM rhnSet + WHERE label = set_label_in + AND user_id = set_uid_in + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + perform rhn_server.set_custom_value(server.element, set_uid_in, key_label_in, value_in); + i := i + 1; + end if; + end loop; + return i; + end$$ language plpgsql; + + create or replace function bulk_snapshot_tag( + org_id_in in numeric, + tagname_in in varchar, + set_label_in in varchar, + set_uid_in in numeric + ) returns void + as $$ + declare + server record; + snapshot_id numeric; + begin + for server in + SELECT user_id, label, element, element_two + FROM rhnSet + WHERE label = set_label_in + AND user_id = set_uid_in + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + select max(id) into snapshot_id + from rhnSnapshot + where server_id = server.element; + + if snapshot_id is null then + perform rhn_server.snapshot_server(server.element, 'tagging system: ' || tagname_in); + + select max(id) into snapshot_id + from rhnSnapshot + where server_id = server.element; + end if; + + -- now have a snapshot_id to work with... + begin + perform rhn_server.tag_snapshot(snapshot_id, org_id_in, tagname_in); + exception + when UNIQUE_VIOLATION + then + -- do nothing, be forgiving... + null; + end; + end if; + end loop; + end$$ language plpgsql; + + create or replace function tag_delete( + server_id_in in numeric, + tag_id_in in numeric + ) returns void + as $$ + declare + snapshots cursor is + select snapshot_id + from rhnSnapshotTag + where tag_id = tag_id_in; + tag_id_tmp numeric; + begin + select id into tag_id_tmp + from rhnTag + where id = tag_id_in + for update; + + delete + from rhnSnapshotTag + where server_id = server_id_in + and tag_id = tag_id_in; + for snapshot in snapshots loop + return; + end loop; + delete + from rhnTag + where id = tag_id_in; + end$$ language plpgsql; + + create or replace function tag_snapshot( + snapshot_id_in in numeric, + org_id_in in numeric, + tagname_in in varchar + ) returns void + as $$ + begin + insert into rhnSnapshotTag (snapshot_id, server_id, tag_id) + select snapshot_id_in, server_id, lookup_tag(org_id_in, tagname_in) + from rhnSnapshot + where id = snapshot_id_in; + end$$ language plpgsql; + + create or replace function bulk_snapshot( + reason_in in varchar, + set_label_in in varchar, + set_uid_in in numeric + ) returns void + as $$ + declare + server record; + begin + for server in + SELECT user_id, label, element, element_two + FROM rhnSet + WHERE label = set_label_in + AND user_id = set_uid_in + loop + if rhn_server.system_service_level(server.element, 'provisioning') = 1 then + perform rhn_server.snapshot_server(server.element, reason_in); + end if; + end loop; + end$$ language plpgsql; + + create or replace function snapshot_server( + server_id_in in numeric, + reason_in in varchar + ) returns void + as $$ + declare + snapshot_id_v numeric; + revisions cursor is + select distinct + cr.id + from rhnConfigRevision cr, + rhnConfigFileName cfn, + rhnConfigFile cf, + rhnConfigChannel cc, + rhnServerConfigChannel scc + where 1=1 + and scc.server_id = server_id_in + and scc.config_channel_id = cc.id + and cc.id = cf.config_channel_id + and cf.id = cr.config_file_id + and cr.id = cf.latest_config_revision_id + and cf.config_file_name_id = cfn.id + and cf.id = lookup_first_matching_cf(scc.server_id, cfn.path); + locked integer; + begin + select nextval('rhn_snapshot_id_seq') into snapshot_id_v; + + insert into rhnSnapshot (id, org_id, server_id, reason) ( + select snapshot_id_v, + s.org_id, + server_id_in, + reason_in + from rhnServer s + where s.id = server_id_in + ); + insert into rhnSnapshotChannel (snapshot_id, channel_id) ( + select snapshot_id_v, sc.channel_id + from rhnServerChannel sc + where sc.server_id = server_id_in + ); + insert into rhnSnapshotServerGroup (snapshot_id, server_group_id) ( + select snapshot_id_v, sgm.server_group_id + from rhnServerGroupMembers sgm + where sgm.server_id = server_id_in + ); + locked := 0; + <<iloop>> + while true loop + begin + insert into rhnPackageNEVRA (id, name_id, evr_id, package_arch_id) + select nextval('rhn_pkgnevra_id_seq'), sp.name_id, sp.evr_id, sp.package_arch_id + from rhnServerPackage sp + where sp.server_id = server_id_in + and not exists + (select 1 + from rhnPackageNEVRA nevra + where nevra.name_id = sp.name_id + and nevra.evr_id = sp.evr_id + and (nevra.package_arch_id = sp.package_arch_id + or (nevra.package_arch_id is null + and sp.package_arch_id is null))); + exit iloop; + exception when unique_violation then + if locked = 1 then + raise; + else + lock table rhnPackageNEVRA in exclusive mode; + locked := 1; + end if; + end; + end loop; + insert into rhnSnapshotPackage (snapshot_id, nevra_id) ( + select distinct snapshot_id_v, nevra.id + from rhnServerPackage sp, rhnPackageNEVRA nevra + where sp.server_id = server_id_in + and nevra.name_id = sp.name_id + and nevra.evr_id = sp.evr_id + and (nevra.package_arch_id = sp.package_arch_id + or (nevra.package_arch_id is null + and sp.package_arch_id is null)) + ); + + insert into rhnSnapshotConfigChannel ( snapshot_id, config_channel_id ) ( + select snapshot_id_v, scc.config_channel_id + from rhnServerConfigChannel scc + where server_id = server_id_in + ); + + for revision in revisions loop + insert into rhnSnapshotConfigRevision ( + snapshot_id, config_revision_id + ) values ( + snapshot_id_v, revision.id + ); + end loop; + end$$ language plpgsql; + + create or replace function remove_action( + server_id_in in numeric, + action_id_in in numeric + ) returns void + as $$ + declare + -- this really wants "nulls last", but 8.1.7.3.0 sucks ass. + -- instead, we make a local table that holds our + -- list of ids with null prereqs. There's surely a better way + -- (an array instead of a table maybe? who knows...) + -- but I've got code to do this handy that I can look at ;) + chained_actions cursor is + with recursive r(id, prerequisite) as ( + select id, prerequisite + from rhnAction + where id = action_id_in + union all + select r1.id, r1.prerequisite + from rhnAction r1, r + where r.id = r1.prerequisite + ) + select * from r + order by prerequisite desc; + sessions cursor is + select s.id + from rhnKickstartSession s + where server_id_in in (s.old_server_id, s.new_server_id) + and s.action_id = action_id_in + and not exists ( + select 1 + from rhnKickstartSessionState ss + where ss.id = s.state_id + and ss.label in ('failed','complete') + ); + chain_ends numeric[]; + i numeric; + prereq numeric := 1; + begin + select prerequisite + into prereq + from rhnAction + where id = action_id_in; + + if prereq is not null then + perform rhn_exception.raise_exception('action_is_child'); + end if; + + chain_ends := '{}'; + i := 1; + for action in chained_actions loop + if action.prerequisite is null then + chain_ends[i] := action.id; + i := i + 1; + else + delete from rhnServerAction + where server_id = server_id_in + and action_id = action.id; + end if; + end loop; + + delete from rhnServerAction + where server_id = server_id_in + and action_id = any(chain_ends); + + for s in sessions loop + update rhnKickstartSession + set state_id = ( + select id + from rhnKickstartSessionState + where label = 'failed' + ), + action_id = null + where id = s.id; + perform set_ks_session_history_message(s.id, 'failed', 'Kickstart cancelled due to action removal'); + end loop; + end$$ language plpgsql; + + create or replace function check_user_access(server_id_in in numeric, user_id_in in numeric) + returns numeric + as $$ + declare + has_access numeric; + begin + -- first check; if this returns no rows, then the server/user are in different orgs, and we bail + select 1 into has_access + from rhnServer S, + web_contact wc + where wc.org_id = s.org_id + and s.id = server_id_in + and wc.id = user_id_in; + + if not found then + return 0; + end if; + + -- okay, so they're in the same org. if we have an org admin, they get a free pass + if rhn_user.check_role(user_id_in, 'org_admin') = 1 + then + return 1; + end if; + + select 1 into has_access + from rhnServerGroupMembers SGM, + rhnUserServerGroupPerms USG + where SGM.server_group_id = USG.server_group_id + and SGM.server_id = server_id_in + and USG.user_id = user_id_in; + + if not found then + return 0; + end if; + + return 1; + end$$ language plpgsql; + + -- ******************************************************************* + -- FUNCTION: can_server_consume_virt_slot + -- Returns 1 if the server id is eligible to consume a virtual slot, + -- else returns 0. + -- Called by: insert_into_servergroup, delete_from_servergroup + -- ******************************************************************* + create or replace function can_server_consume_virt_slot(server_id_in in numeric, + group_type_in in varchar) + returns numeric + as $$ + declare + server_virt_slots cursor is + select vi.VIRTUAL_SYSTEM_ID + from + rhnVirtualInstance vi + where + -- server id is a virtual instance + vi.VIRTUAL_SYSTEM_ID = server_id_in + -- server id's host is virt entitled + and exists ( select 1 + from rhnServerEntitlementView sev + where vi.HOST_SYSTEM_ID = sev.server_id + and sev.label in ('virtualization_host', + 'virtualization_host_platform') ) + -- server id's host also has the ent we want + and exists ( select 1 + from rhnServerEntitlementView sev2 + where vi.HOST_SYSTEM_ID = sev2.server_id + and sev2.label = group_type_in ); + + begin + for server_virt_slot in server_virt_slots loop + return 1; + end loop; + return 0; + end$$ language plpgsql; + + + create or replace function insert_into_servergroup ( + server_id_in in numeric, + server_group_id_in in numeric + ) returns void + as $$ + declare + used_slots numeric; + max_slots numeric; + org_id numeric; + mgmt_available numeric; + mgmt_upgrade numeric; + mgmt_sgid numeric; + prov_available numeric; + prov_upgrade numeric; + prov_sgid numeric; + group_label varchar; + group_type numeric; + begin + -- first, group_type = null, because it's easy... + + -- this will rowlock the servergroup we're trying to change; + -- we probably need to lock the other one, but I think the chances + -- of it being a real issue are very small for now... + select sg.group_type, sg.org_id, sg.current_members, sg.max_members + into group_type, org_id, used_slots, max_slots + from rhnServerGroup sg + where sg.id = server_group_id_in + for update of sg; + + if group_type is null then + if used_slots >= max_slots then + perform rhn_exception.raise_exception('servergroup_max_members'); + end if; + + insert into rhnServerGroupMembers( + server_id, server_group_id + ) values ( + server_id_in, server_group_id_in + ); + update rhnServerGroup + set current_members = current_members + 1 + where id = server_group_id_in; + + perform rhn_cache.update_perms_for_server_group(server_group_id_in); + return; + end if; + + -- now for group_type != null + -- + select label + into group_label + from rhnServerGroupType sgt + where sgt.id = group_type; + + -- the naive easy path that gets hit most often and has to be quickest. + if group_label in ('sw_mgr_entitled', + 'enterprise_entitled', + 'monitoring_entitled', + 'provisioning_entitled', + 'virtualization_host', + 'virtualization_host_platform') then + if used_slots >= max_slots and + (rhn_server.can_server_consume_virt_slot(server_id_in, group_label) != 1) + then + perform rhn_exception.raise_exception('servergroup_max_members'); + end if; + + insert into rhnServerGroupMembers( + server_id, server_group_id + ) values ( + server_id_in, server_group_id_in + ); + + -- Only update current members if the system in consuming a + -- physical slot. + if rhn_server.can_server_consume_virt_slot(server_id_in, group_label) = 0 then + update rhnServerGroup + set current_members = current_members + 1 + where id = server_group_id_in; + end if; + + return; + end if; + end$$ language plpgsql; + + create or replace function insert_into_servergroup_maybe ( + server_id_in in numeric, + server_group_id_in in numeric + ) returns numeric as $$ + declare + retval numeric := 0; + servergroups cursor is + select s.id server_id, + sg.id server_group_id + from rhnServerGroup sg, + rhnServer s + where s.id = server_id_in + and sg.id = server_group_id_in + and s.org_id = sg.org_id + and not exists ( + select 1 + from rhnServerGroupMembers sgm + where sgm.server_id = s.id + and sgm.server_group_id = sg.id + ); + begin + for sgm in servergroups loop + perform rhn_server.insert_into_servergroup(sgm.server_id, sgm.server_group_id); + retval := retval + 1; + end loop; + return retval; + end$$ language plpgsql; + + create or replace function insert_set_into_servergroup ( + server_group_id_in in numeric, + user_id_in in numeric, + set_label_in in varchar + ) returns void + as $$ + declare + servers cursor is + select st.element id + from rhnSet st + where st.user_id = user_id_in + and st.label = set_label_in + and exists ( + select 1 + from rhnUserManagedServerGroups umsg + where umsg.server_group_id = server_group_id_in + and umsg.user_id = user_id_in + ) + and not exists ( + select 1 + from rhnServerGroupMembers sgm + where sgm.server_id = st.element + and sgm.server_group_id = server_group_id_in + ); + begin + for s in servers loop + perform rhn_server.insert_into_servergroup(s.id, server_group_id_in); + end loop; + end$$ language plpgsql; + + create or replace function delete_from_servergroup ( + server_id_in in numeric, + server_group_id_in in numeric + ) returns void + as $$ + declare + server_virt_groups cursor is + select 1 + from rhnServerEntitlementVirtual sev + where sev.server_id = server_id_in + and sev.server_group_id = server_group_id_in; + + oid numeric; + mgmt_sgid numeric; + label varchar; + group_type numeric; + begin + select sg.group_type, sg.org_id + into group_type, oid + from rhnServerGroupMembers sgm, + rhnServerGroup sg + where sg.id = server_group_id_in + and sg.id = sgm.server_group_id + and sgm.server_id = server_id_in + for update of sg; + + if not found then + perform rhn_exception.raise_exception('server_not_in_group'); + end if; + + -- do group_type is null first + if group_type is null then + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + update rhnServerGroup + set current_members = current_members - 1 + where id = server_group_id_in; + perform rhn_cache.update_perms_for_server_group(server_group_id_in); + return; + end if; + + select sgt.label + into label + from rhnServerGroupType sgt + where sgt.id = group_type; + + if label in ('sw_mgr_entitled', + 'enterprise_entitled', + 'provisioning_entitled', + 'monitoring_entitled', + 'virtualization_host', + 'virtualization_host_platform') then + + -- Only update current members if the system is consuming + -- a physical slot. + for server_virt_group in server_virt_groups loop + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + return; + end loop; + + delete from rhnServerGroupMembers + where server_group_id = server_group_id_in + and server_id = server_id_in; + + update rhnServerGroup + set current_members = current_members - 1 + where id = server_group_id_in; + + end if; + end$$ language plpgsql; + + create or replace function delete_set_from_servergroup ( + server_group_id_in in numeric, + user_id_in in numeric, + set_label_in in varchar + ) returns void + as $$ + declare + servergroups cursor is + select sgm.server_id, sgm.server_group_id + from rhnSet st, + rhnServerGroupMembers sgm + where sgm.server_group_id = server_group_id_in + and st.user_id = user_id_in + and st.label = set_label_in + and sgm.server_id = st.element + and exists ( + select 1 + from rhnUserManagedServerGroups usgp + where usgp.server_group_id = server_group_id_in + and usgp.user_id = user_id_in + ); + begin + for sgm in servergroups loop + perform rhn_server.delete_from_servergroup(sgm.server_id, server_group_id_in); + end loop; + end$$ language plpgsql; + + create or replace function clear_servergroup ( + server_group_id_in in numeric + ) returns void + as $$ + declare + servers cursor is + select sgm.server_id id + from rhnServerGroupMembers sgm + where sgm.server_group_id = server_group_id_in; + begin + for s in servers loop + perform rhn_server.delete_from_servergroup(s.id, server_group_id_in); + end loop; + end$$ language plpgsql; + + create or replace function delete_from_org_servergroups ( + server_id_in in numeric + ) returns void + as $$ + declare + servergroups cursor is + select sgm.server_group_id id + from rhnServerGroup sg, + rhnServerGroupMembers sgm + where sgm.server_id = server_id_in + and sgm.server_group_id = sg.id + and sg.group_type is null; + begin + for sg in servergroups loop + perform rhn_server.delete_from_servergroup(server_id_in, sg.id); + end loop; + end$$ language plpgsql; + + create or replace function get_ip_address ( + server_id_in in numeric + ) returns varchar as $$ + declare + interfaces cursor is + select ni.name as name, na4.address as address + from rhnServerNetInterface ni, + rhnServerNetAddress4 na4 + where server_id = server_id_in + and ni.id = na4.interface_id + and na4.address != '127.0.0.1'; + addresses cursor is + select ipaddr ip_addr + from rhnServerNetwork + where server_id = server_id_in + and ipaddr != '127.0.0.1'; + begin + for addr in addresses loop + return addr.ip_addr; + end loop; + for iface in interfaces loop + return iface.address; + end loop; + return NULL; + end$$ language plpgsql; + + create or replace function update_needed_cache( + server_id_in in numeric + ) returns void as $$ + begin + delete from rhnServerNeededCache + where server_id = server_id_in; + insert into rhnServerNeededCache + (server_id, errata_id, package_id) + (select distinct server_id, errata_id, package_id + from rhnServerNeededView + where server_id = server_id_in); + end$$ language plpgsql; + +-- restore the original setting +update pg_settings set setting = overlay( setting placing '' from 1 for (length('rhn_server')+1) ) where name = 'search_path'; commit cee165a5cdd26112f2cc2cbb9774f894c10675b2 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Thu Oct 20 19:19:02 2011 +0200 schema upgrade diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index 7042fb2..b451aa3 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -31,10 +31,10 @@ CREATE TABLE rhnServerNetAddress4 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_net_addr4_iid_addr_idx +CREATE INDEX rhn_srv_net_addr4_iid_addr_idx ON rhnServerNetAddress4 (interface_id, address) - TABLESPACE [[8m_tbs]]; + TABLESPACE [[64k_tbs]]; ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_net_add4_iid_addr_uq UNIQUE (interface_id, address); + ADD CONSTRAINT rhn_srv_net_addr4_iid_addr_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index ee04fe5..79b10e4 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -31,10 +31,10 @@ CREATE TABLE rhnServerNetAddress6 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_net_addr6_iid_sc_addr_idx +CREATE INDEX rhn_srv_net_ad6_iid_sc_ad_idx ON rhnServerNetAddress6 (interface_id, scope, address) - TABLESPACE [[8m_tbs]]; + TABLESPACE [[64_tbs]]; ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_net_addr6_iid_sc_addr_uq UNIQUE (interface_id, scope, address); + ADD CONSTRAINT rhn_srv_net_ad6_iid_sc_ad_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle new file mode 100644 index 0000000..1f0ab2a --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.oracle @@ -0,0 +1,9 @@ +alter table rhnServerNetInterface add id number; + +create sequence rhn_srv_net_iface_id_seq; + +update rhnServerNetInterface set id = rhn_srv_net_iface_id_seq.nextval; + +alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_nn check (id is not null); + +alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_pk primary key ( id ); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql new file mode 100644 index 0000000..c2b448d --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/105-alter_rhnServerNetInterface.sql.postgresql @@ -0,0 +1,11 @@ +-- oracle equivalent source sha1 f5872e029cf1b053c88bd876afc8f253461772ac + +alter table rhnServerNetInterface add id numeric; + +create sequence rhn_srv_net_iface_id_seq; + +update rhnServerNetInterface set id = nextval('rhn_srv_net_iface_id_seq'); + +alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_nn check (id is not null); + +alter table rhnServerNetInterface add constraint rhn_srv_net_iface_id_pk primary key ( id ); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle new file mode 100644 index 0000000..7922fdf --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.oracle @@ -0,0 +1,39 @@ +-- +-- Copyright (c) 2011 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- + + +CREATE TABLE rhnServerNetAddress4 +( + interface_id NUMBER NOT NULL + CONSTRAINT rhn_srv_net_iaddress4_iid_fk + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, + address VARCHAR2(64), + netmask VARCHAR2(64), + broadcast VARCHAR2(64), + created DATE + DEFAULT (sysdate) NOT NULL, + modified DATE + DEFAULT (sysdate) NOT NULL +) +ENABLE ROW MOVEMENT +; + +CREATE INDEX rhn_srv_net_addr4_iid_addr_idx + ON rhnServerNetAddress4 (interface_id, address) + TABLESPACE [[64k_tbs]]; + +ALTER TABLE rhnServerNetAddress4 + ADD CONSTRAINT rhn_srv_net_addr4_iid_addr_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql new file mode 100644 index 0000000..7b8a6b7 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/110-add_rhnServerNetAddress4.sql.postgresql @@ -0,0 +1,18 @@ +-- oracle equivalent source sha1 af31dbcccd3799c2cd577137f6f7fd608288b2c4 + +CREATE TABLE rhnServerNetAddress4 +( + interface_id NUMERIC NOT NULL + CONSTRAINT rhn_srv_net_iaddress4_iid_fk + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, + address VARCHAR(64), + netmask VARCHAR(64), + broadcast VARCHAR(64), + created timestamptz default current_timestamp NOT NULL, + modified timestamptz default current_timestamp NOT NULL +); + +CREATE UNIQUE INDEX rhn_srv_net_addr4_iid_addr_uq + ON rhnServerNetAddress4 (interface_id, address) + ; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql new file mode 100644 index 0000000..bda4fb8 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/111-add_rhnServerNetAddress4_data.sql @@ -0,0 +1,6 @@ +INSERT INTO rhnServerNetAddress4 + (interface_id, address, netmask, broadcast, created) + SELECT id, ip_addr, netmask, broadcast, created + FROM rhnServerNetInterface; + +COMMIT; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql new file mode 100644 index 0000000..64e42e1 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/115-drop_columns_rhnServerNetInterface.sql @@ -0,0 +1,3 @@ +ALTER TABLE rhnServerNetInterface DROP COLUMN ip_addr; +ALTER TABLE rhnServerNetInterface DROP COLUMN netmask; +ALTER TABLE rhnServerNetInterface DROP COLUMN broadcast; diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle new file mode 100644 index 0000000..42c78b2 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.oracle @@ -0,0 +1,39 @@ +-- +-- Copyright (c) 2011 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- + + +CREATE TABLE rhnServerNetAddress6 +( + interface_id NUMBER NOT NULL + CONSTRAINT rhn_srv_net_iaddress6_iid_fk + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, + address VARCHAR2(45), + netmask VARCHAR2(49), + scope VARCHAR2(64), + created DATE + DEFAULT (sysdate) NOT NULL, + modified DATE + DEFAULT (sysdate) NOT NULL +) +ENABLE ROW MOVEMENT +; + +CREATE INDEX rhn_srv_net_ad6_iid_sc_ad_idx + ON rhnServerNetAddress6 (interface_id, scope, address) + TABLESPACE [[64k_tbs]]; + +ALTER TABLE rhnServerNetAddress6 + ADD CONSTRAINT rhn_srv_net_ad6_iid_sc_ad_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql new file mode 100644 index 0000000..844c601 --- /dev/null +++ b/schema/spacewalk/upgrade/spacewalk-schema-1.5-to-spacewalk-schema-1.6/120-add_rhnServerNetAddress6.sql.postgresql @@ -0,0 +1,17 @@ +-- oracle equivalent source sha1 7c11068302cdb144f446828d4db0f244dbf12293 + +CREATE TABLE rhnServerNetAddress6 +( + interface_id NUMERIC NOT NULL + CONSTRAINT rhn_srv_net_iaddress6_iid_fk + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, + address VARCHAR(45), + netmask VARCHAR(49), + scope VARCHAR(64), + created timestamptz default current_timestamp NOT NULL, + modified timestamptz default current_timestamp NOT NULL +); + +CREATE UNIQUE INDEX rhn_srv_net_ad6_iid_sc_ad_uq + ON rhnServerNetAddress6 (interface_id, scope, address); commit 08ea44500d91d22877f0f361735df518ae601bd7 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 18:38:45 2011 +0200 get_hw_info_as_clob: adapt to IPv6 changes diff --git a/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql b/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql index ce1b580..d6fea07 100644 --- a/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql +++ b/schema/spacewalk/oracle/procs/get_hw_info_as_clob.sql @@ -15,9 +15,11 @@ begin select 1 n, sum(nrcpu) || ' CPUs' m from rhncpu where rhncpu.server_id = sid union all - select 2, name||' '||ip_addr||'/'||netmask||' '||hw_addr val - from rhnservernetinterface - where rhnservernetinterface.server_id = sid + select 2, ni.name||' '||na4.address||'/'||na4.netmask||' '||ni.hw_addr val + from rhnservernetinterface ni, + rhnServerNetAddress4 na4 + where ni.server_id = sid + and ni.id = na4.interface_id ) order by n, m ) loop diff --git a/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql b/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql index 9d899f3..6cc1982 100644 --- a/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql +++ b/schema/spacewalk/postgres/procs/get_hw_info_as_clob.sql @@ -1,4 +1,4 @@ --- oracle equivalent source sha1 4a627f5b31efb66c684dd14f0514e25a5ace94f2 +-- oracle equivalent source sha1 6a538f3b05d412810baec118fbb7860348c60cd4 create or replace function get_hw_info_as_clob( sid in rhnserver.id%TYPE, @@ -17,9 +17,11 @@ begin select 1 n, sum(nrcpu) || ' CPUs' m from rhncpu where rhncpu.server_id = sid union all - select 2, name||' '||coalesce(ip_addr,'')||'/'||coalesce(netmask,'')||' '||hw_addr val - from rhnservernetinterface - where rhnservernetinterface.server_id = sid + select 2, ni.name||' '||coalesce(na4.address,'')||'/'||coalesce(na4.netmask,'')||' '||ni.hw_addr val + from rhnservernetinterface, + rhnServerNetAddress4 na4 + where ni.server_id = sid + and ni.id = na4.interface_id ) X order by n, m ) loop commit c8d1e52a302aaea688b049804bec6f441577d6e1 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 17:48:58 2011 +0200 update rhn_server.get_ip_address() to reflect IPv6 changes diff --git a/schema/spacewalk/oracle/packages/rhn_server.pkb b/schema/spacewalk/oracle/packages/rhn_server.pkb index 72392fd..8e3c640 100644 --- a/schema/spacewalk/oracle/packages/rhn_server.pkb +++ b/schema/spacewalk/oracle/packages/rhn_server.pkb @@ -712,10 +712,12 @@ is server_id_in in number ) return varchar2 is cursor interfaces is - select name, ip_addr - from rhnServerNetInterface - where server_id = server_id_in - and ip_addr != '127.0.0.1'; + select ni.name as name, na4.address as address + from rhnServerNetInterface ni, + rhnServerNetAddress4 na4 + where ni.server_id = server_id_in + and ni.id = na4.interface_id + and na4.address != '127.0.0.1'; cursor addresses is select ipaddr ip_addr from rhnServerNetwork @@ -726,7 +728,7 @@ is return addr.ip_addr; end loop; for iface in interfaces loop - return iface.ip_addr; + return iface.address; end loop; return NULL; end get_ip_address; diff --git a/schema/spacewalk/postgres/packages/rhn_server.pkb b/schema/spacewalk/postgres/packages/rhn_server.pkb index 3533094..a1f7aca 100644 --- a/schema/spacewalk/postgres/packages/rhn_server.pkb +++ b/schema/spacewalk/postgres/packages/rhn_server.pkb @@ -764,10 +764,12 @@ update pg_settings set setting = 'rhn_server,' || setting where name = 'search_p ) returns varchar as $$ declare interfaces cursor is - select name, ip_addr - from rhnServerNetInterface + select ni.name as name, na4.address as address + from rhnServerNetInterface ni, + rhnServerNetAddress4 na4 where server_id = server_id_in - and ip_addr != '127.0.0.1'; + and ni.id = na4.interface_id + and na4.address != '127.0.0.1'; addresses cursor is select ipaddr ip_addr from rhnServerNetwork @@ -778,7 +780,7 @@ update pg_settings set setting = 'rhn_server,' || setting where name = 'search_p return addr.ip_addr; end loop; for iface in interfaces loop - return iface.ip_addr; + return iface.address; end loop; return NULL; end$$ language plpgsql; commit 7be1ad0da7a79a3a445437770540cfe0824850f5 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 17:38:13 2011 +0200 delete from rhnServerNetInterface: add on delete cascade diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index edf90ce..7042fb2 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -18,7 +18,8 @@ CREATE TABLE rhnServerNetAddress4 ( interface_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iaddress4_iid_fk - REFERENCES rhnServerNetInterface (id), + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, address VARCHAR2(64), netmask VARCHAR2(64), broadcast VARCHAR2(64), diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index 6413ba5..ee04fe5 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -18,7 +18,8 @@ CREATE TABLE rhnServerNetAddress6 ( interface_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iaddress6_iid_fk - REFERENCES rhnServerNetInterface (id), + REFERENCES rhnServerNetInterface (id) + ON DELETE CASCADE, address VARCHAR2(45), netmask VARCHAR2(49), scope VARCHAR2(64), commit deb1ff2107ca7db37389e85bfdb39a79bad8e2b9 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 17:12:56 2011 +0200 correct index creation diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index 7dbde6c..6413ba5 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -31,7 +31,7 @@ ENABLE ROW MOVEMENT ; CREATE INDEX rhn_net_addr6_iid_sc_addr_idx - ON rhnServerNetAddress4 (interface_id, scope, address) + ON rhnServerNetAddress6 (interface_id, scope, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress6 commit 72ab8d4d2e7516036ace9604eac51da399d6d1d1 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 17:07:28 2011 +0200 shorten constraint identifiers to fit into given limits diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql index 6db6d3b..edf90ce 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -30,9 +30,10 @@ CREATE TABLE rhnServerNetAddress4 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_srv_net_address4_iid_address_idx +CREATE INDEX rhn_net_addr4_iid_addr_idx ON rhnServerNetAddress4 (interface_id, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress4 - ADD CONSTRAINT rhn_srv_net_address4_iid_address_uq UNIQUE (interface_id, address); + ADD CONSTRAINT rhn_net_add4_iid_addr_uq UNIQUE (interface_id, address); + diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql index dce721d..7dbde6c 100644 --- a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -30,9 +30,10 @@ CREATE TABLE rhnServerNetAddress6 ENABLE ROW MOVEMENT ; -CREATE INDEX rhn_srv_net_address6_iid_scope_address_idx +CREATE INDEX rhn_net_addr6_iid_sc_addr_idx ON rhnServerNetAddress4 (interface_id, scope, address) TABLESPACE [[8m_tbs]]; ALTER TABLE rhnServerNetAddress6 - ADD CONSTRAINT rhn_srv_net_address6_iid_scope_address_uq UNIQUE (interface_id, scope, address); + ADD CONSTRAINT rhn_net_addr6_iid_sc_addr_uq UNIQUE (interface_id, scope, address); + commit 4c6f241a4cfe99cac08d18a63b969e815d10cbba Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Thu Oct 20 16:56:40 2011 +0200 Fix table dependencies diff --git a/schema/spacewalk/common/tables/tables.deps b/schema/spacewalk/common/tables/tables.deps index 53fc6c7..692e4b4 100644 --- a/schema/spacewalk/common/tables/tables.deps +++ b/schema/spacewalk/common/tables/tables.deps @@ -105,6 +105,8 @@ rhnKickstartSessionHistory :: rhnKickstartSession rhnKickstartSessionState rhnKSTreeFile :: rhnKickstartableTree rhnChannelErrata rhnErrata \ rhnChecksum rhnKickstartTimezone :: rhnKSInstallType +rhnServerNetAddress4 :: rhnServerNetInterface +rhnServerNetAddress6 :: rhnServerNetInterface rhnOrgChannelSettings :: web_customer rhnChannel rhnOrgChannelSettingsType rhnOrgEntitlements :: rhnOrgEntitlementType rhnOrgErrataCacheQueue :: web_customer commit 780ba79c8d5edb50c312b522c6b8972db0d812a3 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Thu Oct 20 12:55:30 2011 +0200 schema change diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress4.sql b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql new file mode 100644 index 0000000..6db6d3b --- /dev/null +++ b/schema/spacewalk/common/tables/rhnServerNetAddress4.sql @@ -0,0 +1,38 @@ +-- +-- Copyright (c) 2011 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- + + +CREATE TABLE rhnServerNetAddress4 +( + interface_id NUMBER NOT NULL + CONSTRAINT rhn_srv_net_iaddress4_iid_fk + REFERENCES rhnServerNetInterface (id), + address VARCHAR2(64), + netmask VARCHAR2(64), + broadcast VARCHAR2(64), + created DATE + DEFAULT (sysdate) NOT NULL, + modified DATE + DEFAULT (sysdate) NOT NULL +) +ENABLE ROW MOVEMENT +; + +CREATE INDEX rhn_srv_net_address4_iid_address_idx + ON rhnServerNetAddress4 (interface_id, address) + TABLESPACE [[8m_tbs]]; + +ALTER TABLE rhnServerNetAddress4 + ADD CONSTRAINT rhn_srv_net_address4_iid_address_uq UNIQUE (interface_id, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetAddress6.sql b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql new file mode 100644 index 0000000..dce721d --- /dev/null +++ b/schema/spacewalk/common/tables/rhnServerNetAddress6.sql @@ -0,0 +1,38 @@ +-- +-- Copyright (c) 2011 Red Hat, Inc. +-- +-- This software is licensed to you under the GNU General Public License, +-- version 2 (GPLv2). There is NO WARRANTY for this software, express or +-- implied, including the implied warranties of MERCHANTABILITY or FITNESS +-- FOR A PARTICULAR PURPOSE. You should have received a copy of GPLv2 +-- along with this software; if not, see +-- http://www.gnu.org/licenses/old-licenses/gpl-2.0.txt. +-- +-- Red Hat trademarks are not licensed under GPLv2. No permission is +-- granted to use or replicate Red Hat trademarks that are incorporated +-- in this software or its documentation. +-- + + +CREATE TABLE rhnServerNetAddress6 +( + interface_id NUMBER NOT NULL + CONSTRAINT rhn_srv_net_iaddress6_iid_fk + REFERENCES rhnServerNetInterface (id), + address VARCHAR2(45), + netmask VARCHAR2(49), + scope VARCHAR2(64), + created DATE + DEFAULT (sysdate) NOT NULL, + modified DATE + DEFAULT (sysdate) NOT NULL +) +ENABLE ROW MOVEMENT +; + +CREATE INDEX rhn_srv_net_address6_iid_scope_address_idx + ON rhnServerNetAddress4 (interface_id, scope, address) + TABLESPACE [[8m_tbs]]; + +ALTER TABLE rhnServerNetAddress6 + ADD CONSTRAINT rhn_srv_net_address6_iid_scope_address_uq UNIQUE (interface_id, scope, address); diff --git a/schema/spacewalk/common/tables/rhnServerNetInterface.sql b/schema/spacewalk/common/tables/rhnServerNetInterface.sql index f115885..6d73c23 100644 --- a/schema/spacewalk/common/tables/rhnServerNetInterface.sql +++ b/schema/spacewalk/common/tables/rhnServerNetInterface.sql @@ -1,5 +1,5 @@ -- --- Copyright (c) 2008 Red Hat, Inc. +-- Copyright (c) 2008 -- 2011 Red Hat, Inc. -- -- This software is licensed to you under the GNU General Public License, -- version 2 (GPLv2). There is NO WARRANTY for this software, express or @@ -16,13 +16,13 @@ CREATE TABLE rhnServerNetInterface ( + id NUMBER NOT NULL + CONSTRAINT rhn_srv_net_iface_id_pk PRIMARY KEY + USING INDEX TABLESPACE [[4m_tbs]], server_id NUMBER NOT NULL CONSTRAINT rhn_srv_net_iface_sid_fk REFERENCES rhnServer (id), name VARCHAR2(32) NOT NULL, - ip_addr VARCHAR2(64), - netmask VARCHAR2(64), - broadcast VARCHAR2(64), hw_addr VARCHAR2(18), module VARCHAR2(128), created DATE @@ -40,3 +40,4 @@ CREATE INDEX rhn_srv_net_iface_sid_name_idx ALTER TABLE rhnServerNetInterface ADD CONSTRAINT rhn_srv_net_iface_sid_name_uq UNIQUE (server_id, name); +CREATE SEQUENCE rhn_srv_net_iface_id_seq; commit 4c035e6b60993d4589643ad41b7146dee7b2390d Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 17:56:11 2011 +0200 Automatic commit of package [rhn-virtualization] release [5.4.28-1]. diff --git a/client/tools/rhn-virtualization/rhn-virtualization.spec b/client/tools/rhn-virtualization/rhn-virtualization.spec index 8dfb9c5..2aebabd 100644 --- a/client/tools/rhn-virtualization/rhn-virtualization.spec +++ b/client/tools/rhn-virtualization/rhn-virtualization.spec @@ -10,7 +10,7 @@ License: GPLv2 URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz -Version: 5.4.27 +Version: 5.4.28 Release: 1%{?dist} BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildArch: noarch @@ -134,6 +134,9 @@ rm -rf $RPM_BUILD_ROOT %doc LICENSE %changelog +* Wed Oct 26 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 5.4.28-1 +- 742811 - don't open RW connection to libvirt unless necessary + * Wed Oct 26 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 5.4.27-1 - 742811 - RHEV: handle no-guests situation correctly diff --git a/rel-eng/packages/rhn-virtualization b/rel-eng/packages/rhn-virtualization index d3ff2bb..0905e4c 100644 --- a/rel-eng/packages/rhn-virtualization +++ b/rel-eng/packages/rhn-virtualization @@ -1 +1 @@ -5.4.27-1 client/tools/rhn-virtualization/ +5.4.28-1 client/tools/rhn-virtualization/ commit ef1a8f4565d0460c3d58cd268ee989585571ae8a Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 17:55:02 2011 +0200 742811 - don't open RW connection to libvirt unless necessary diff --git a/client/tools/rhn-virtualization/virtualization/domain_control.py b/client/tools/rhn-virtualization/virtualization/domain_control.py index 535ec22..f9103d8 100755 --- a/client/tools/rhn-virtualization/virtualization/domain_control.py +++ b/client/tools/rhn-virtualization/virtualization/domain_control.py @@ -110,7 +110,7 @@ def _get_domain(uuid): """ Lookup the domain by its UUID. If not found, raise an exception. """ - conn = libvirt.open(None) + conn = libvirt.openReadOnly(None) domain = None hyphenized_uuid = hyphenize_uuid(uuid) try: diff --git a/client/tools/rhn-virtualization/virtualization/poller.py b/client/tools/rhn-virtualization/virtualization/poller.py index 9a7eea5..f94e122 100644 --- a/client/tools/rhn-virtualization/virtualization/poller.py +++ b/client/tools/rhn-virtualization/virtualization/poller.py @@ -72,7 +72,7 @@ def poll_hypervisor(): return {} try: - conn = libvirt.open(None) + conn = libvirt.openReadOnly(None) except libvirt.libvirtError, lve: # virConnectOpen() failed sys.stderr.write(_("Warning: Could not retrieve virtualization information!\n\tlibvirtd service needs to be running.\n")) @@ -193,7 +193,7 @@ def poll_state(uuid): Polls just the state of the guest with the provided UUID. This state is returned. """ - conn = libvirt.open(None) + conn = libvirt.openReadOnly(None) if not conn: raise VirtualizationException, \ "Failed to open connection to hypervisor." diff --git a/client/tools/rhn-virtualization/virtualization/support.py b/client/tools/rhn-virtualization/virtualization/support.py index 160693c..547ca72 100755 --- a/client/tools/rhn-virtualization/virtualization/support.py +++ b/client/tools/rhn-virtualization/virtualization/support.py @@ -82,7 +82,7 @@ def refresh(): else: domains = poller.poll_hypervisor() - if not len(domains) and libvirt.open(None).getType() == 'Xen': + if not len(domains) and libvirt.openReadOnly(None).getType() == 'Xen': # On a KVM/QEMU host, libvirt reports no domain entry for host itself # On a Xen host, either there were no domains or xend might not be # running. Don't proceed further. @@ -184,7 +184,7 @@ def _is_host_domain(): # No libvirt, dont bother with the rest return False try: - conn = libvirt.open(None) + conn = libvirt.openReadOnly(None) except libvirt.libvirtError: # libvirtd is not running sys.stderr.write(_("Warning: Could not retrieve virtualization information!\n\tlibvirtd service needs to be running.\n")) return False commit d15c5cbfe65430e14059085092e20ff846bbd90a Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 17:29:48 2011 +0200 Automatic commit of package [rhn-virtualization] release [5.4.27-1]. diff --git a/client/tools/rhn-virtualization/rhn-virtualization.spec b/client/tools/rhn-virtualization/rhn-virtualization.spec index 560d516..8dfb9c5 100644 --- a/client/tools/rhn-virtualization/rhn-virtualization.spec +++ b/client/tools/rhn-virtualization/rhn-virtualization.spec @@ -10,7 +10,7 @@ License: GPLv2 URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz -Version: 5.4.26 +Version: 5.4.27 Release: 1%{?dist} BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildArch: noarch @@ -134,6 +134,9 @@ rm -rf $RPM_BUILD_ROOT %doc LICENSE %changelog +* Wed Oct 26 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 5.4.27-1 +- 742811 - RHEV: handle no-guests situation correctly + * Wed Oct 05 2011 Martin Minar <mminar(a)redhat.com> 5.4.26-1 - 742811 - check for running vdsm only (colin.coe(a)gmail.com) diff --git a/rel-eng/packages/rhn-virtualization b/rel-eng/packages/rhn-virtualization index 8578002..d3ff2bb 100644 --- a/rel-eng/packages/rhn-virtualization +++ b/rel-eng/packages/rhn-virtualization @@ -1 +1 @@ -5.4.26-1 client/tools/rhn-virtualization/ +5.4.27-1 client/tools/rhn-virtualization/ commit 7c9386db278b848c317b1718d2331cb3078f0d51 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 17:24:16 2011 +0200 742811 - RHEV: handle no-guests situation correctly This fix is to avoid traceback: File "/usr/share/rhn/virtualization/support.py", line 95, in refresh domain_list = domains.values() AttributeError: 'NoneType' object has no attribute 'values' diff --git a/client/tools/rhn-virtualization/virtualization/poller.py b/client/tools/rhn-virtualization/virtualization/poller.py index 8b96f0d..9a7eea5 100644 --- a/client/tools/rhn-virtualization/virtualization/poller.py +++ b/client/tools/rhn-virtualization/virtualization/poller.py @@ -151,7 +151,7 @@ def poll_through_vdsm(): if not len(domains['vmList']): # No domains, exit. - return + return {} state = {} for domain in domains['vmList']: commit 72dac51c8bb9141e34fcfca89f528fdb7bbc7e2e Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Wed Oct 26 17:19:26 2011 +0200 Automatic commit of package [spacewalk-proxy] release [1.6.5-1]. diff --git a/proxy/proxy/spacewalk-proxy.spec b/proxy/proxy/spacewalk-proxy.spec index 990795f..ed155f5 100644 --- a/proxy/proxy/spacewalk-proxy.spec +++ b/proxy/proxy/spacewalk-proxy.spec @@ -4,7 +4,7 @@ Group: Applications/Internet License: GPLv2 URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz -Version: 1.6.4 +Version: 1.6.5 Release: 1%{?dist} BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) BuildRequires: python @@ -320,6 +320,9 @@ fi %changelog +* Wed Oct 26 2011 Miroslav SuchÃœ 1.6.5-1 +- there is no rhn-proxy-debug for some time + * Mon Oct 17 2011 Miroslav SuchÃœ 1.6.4-1 - 719659 - correctly handle getpeername() on IPv6 diff --git a/rel-eng/packages/spacewalk-proxy b/rel-eng/packages/spacewalk-proxy index 58fbc09..aafbeb1 100644 --- a/rel-eng/packages/spacewalk-proxy +++ b/rel-eng/packages/spacewalk-proxy @@ -1 +1 @@ -1.6.4-1 proxy/proxy/ +1.6.5-1 proxy/proxy/ commit 25b92434dd42c2311b9970fd6abd9256d21b8cb9 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Wed Oct 26 17:19:13 2011 +0200 Automatic commit of package [spacewalk-proxy-installer] release [1.6.7-1]. diff --git a/proxy/installer/spacewalk-proxy-installer.spec b/proxy/installer/spacewalk-proxy-installer.spec index a56a807..c81b408 100644 --- a/proxy/installer/spacewalk-proxy-installer.spec +++ b/proxy/installer/spacewalk-proxy-installer.spec @@ -2,7 +2,7 @@ Name: spacewalk-proxy-installer Summary: Spacewalk Proxy Server Installer Group: Applications/Internet License: GPLv2 -Version: 1.6.6 +Version: 1.6.7 Release: 1%{?dist} URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz @@ -84,6 +84,9 @@ rm -rf $RPM_BUILD_ROOT %doc LICENSE answers.txt %changelog +* Wed Oct 26 2011 Miroslav SuchÃœ 1.6.7-1 +- there is no rhn-proxy-debug for some time + * Mon Oct 24 2011 Miroslav SuchÃœ 1.6.6-1 - increase maximum_object_size_in_memory - comment some squid directives diff --git a/rel-eng/packages/spacewalk-proxy-installer b/rel-eng/packages/spacewalk-proxy-installer index e6adfab..34cfc7e 100644 --- a/rel-eng/packages/spacewalk-proxy-installer +++ b/rel-eng/packages/spacewalk-proxy-installer @@ -1 +1 @@ -1.6.6-1 proxy/installer/ +1.6.7-1 proxy/installer/ commit a2eadd8cefe399452a4ad41884806b67bf7a7abc Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Wed Oct 26 17:18:42 2011 +0200 there is no rhn-proxy-debug for some time diff --git a/proxy/installer/rhn-proxy-activate.sgml b/proxy/installer/rhn-proxy-activate.sgml index d01e04c..2ab1b0d 100644 --- a/proxy/installer/rhn-proxy-activate.sgml +++ b/proxy/installer/rhn-proxy-activate.sgml @@ -166,7 +166,6 @@ <simplelist> <member>rhn_package_manager(8)</member> <member>rhn-proxy(8)</member> - <member>rhn-proxy-debug(8)</member> <member>configure-proxy.sh(8)</member> </simplelist> </RefSect1> diff --git a/proxy/proxy/pm/rhn_package_manager.sgml b/proxy/proxy/pm/rhn_package_manager.sgml index 4c010d7..2ba0711 100644 --- a/proxy/proxy/pm/rhn_package_manager.sgml +++ b/proxy/proxy/pm/rhn_package_manager.sgml @@ -193,7 +193,6 @@ Manages RPM packages for the RHN proxy <simplelist> <member>rhn-proxy(8)</member> <member>rhn-proxy-activate(8)</member> - <member>rhn-proxy-debug(8)</member> </simplelist> </RefSect1> diff --git a/proxy/proxy/rhn-proxy.sgml b/proxy/proxy/rhn-proxy.sgml index b63bf2b..1c3177a 100644 --- a/proxy/proxy/rhn-proxy.sgml +++ b/proxy/proxy/rhn-proxy.sgml @@ -41,7 +41,6 @@ <simplelist> <member>rhn_package_manager(8)</member> <member>rhn-proxy-activate(8)</member> - <member>rhn-proxy-debug(8)</member> </simplelist> </RefSect1> commit 7192bfb40384503cba9818d05827438cfc354270 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Wed Oct 26 13:23:10 2011 +0200 When there are not ks-pre.log files, do not return error. diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java index 6725be1..8f170f0 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java @@ -134,7 +134,7 @@ public class KickstartFormatter { "cp -fa /tmp/ks-tree-shadow/* /mnt/sysimage/tmp/ks-tree-copy" + NEWLINE + "fi" + NEWLINE + "cp /etc/resolv.conf /mnt/sysimage/etc/resolv.conf" + NEWLINE + - "cp -f /tmp/ks-pre.log* /mnt/sysimage/root/" + NEWLINE; + "cp -f /tmp/ks-pre.log* /mnt/sysimage/root/ || :" + NEWLINE; private static final String RHN_TRACE = "set -x" + NEWLINE; private static final String XMLRPC_HOST = Config.get().getString(ConfigDefaults.KICKSTART_HOST, "xmlrpc.rhn.redhat.com"); commit 502ccf36baae45950825ed75141837a25570d7b3 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Wed Oct 26 13:18:52 2011 +0200 Doing replacement on all files is not nice. Addressing Can't do inplace edit: /etc/sysconfig/rhn/allowed-actions is not a regular file. Can't do inplace edit: /etc/sysconfig/rhn/clientCaps.d is not a regular file. diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java index 8dbd68e..6725be1 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java @@ -924,7 +924,7 @@ public class KickstartFormatter { retval.append("cat /tmp/ssl-key-* > /usr/share/rhn/RHN-ORG-TRUSTED-SSL-CERT" + NEWLINE); retval.append("perl -pe 's/RHNS-CA-CERT/RHN-ORG-TRUSTED-SSL-CERT/g' " + - "-i /etc/sysconfig/rhn/*" + NEWLINE); + "-i /etc/sysconfig/rhn/up2date" + NEWLINE); return retval.toString(); } commit 53ce9f6790b14578235b43a7a28bb9f6ba7a7925 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Wed Oct 26 13:16:45 2011 +0200 The -n and -p are exclusive in perl, let us just settle on -p. diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java index 4dcc559..8dbd68e 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartFormatter.java @@ -923,7 +923,7 @@ public class KickstartFormatter { retval.append("cat /tmp/ssl-key-* > /usr/share/rhn/RHN-ORG-TRUSTED-SSL-CERT" + NEWLINE); - retval.append("perl -npe 's/RHNS-CA-CERT/RHN-ORG-TRUSTED-SSL-CERT/g' " + + retval.append("perl -pe 's/RHNS-CA-CERT/RHN-ORG-TRUSTED-SSL-CERT/g' " + "-i /etc/sysconfig/rhn/*" + NEWLINE); return retval.toString(); commit 2df5137ea5be18beb58f75d30864bb5f215cffb5 Author: Tomas Lestach <tlestach(a)redhat.com> Date: Wed Oct 26 11:04:48 2011 +0200 748903 - extend search_string maxlenght diff --git a/java/code/webapp/WEB-INF/pages/systems/systemsearch.jsp b/java/code/webapp/WEB-INF/pages/systems/systemsearch.jsp index 8faf9e5..6fa59d2 100644 --- a/java/code/webapp/WEB-INF/pages/systems/systemsearch.jsp +++ b/java/code/webapp/WEB-INF/pages/systems/systemsearch.jsp @@ -26,7 +26,7 @@ <tr><th><label for="searchfor"><bean:message key="erratasearch.jsp.searchfor"/></label></th> <td> <html:text property="search_string" name="search_string" styleId="searchfor" - value="${search_string}" maxlength="36" accesskey="4"/> + value="${search_string}" maxlength="100" accesskey="4"/> <html:submit> <bean:message key="button.search" /> </html:submit> commit 967768b088f56f323f4d80c9ce29202264b85e28 Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 11:23:20 2011 +0200 Automatic commit of package [spacewalk-setup-jabberd] release [1.6.4-1]. diff --git a/rel-eng/packages/spacewalk-setup-jabberd b/rel-eng/packages/spacewalk-setup-jabberd index 097446d..9b50ab1 100644 --- a/rel-eng/packages/spacewalk-setup-jabberd +++ b/rel-eng/packages/spacewalk-setup-jabberd @@ -1 +1 @@ -1.6.3-1 spacewalk/spacewalk-setup-jabberd/ +1.6.4-1 spacewalk/spacewalk-setup-jabberd/ diff --git a/spacewalk/spacewalk-setup-jabberd/spacewalk-setup-jabberd.spec b/spacewalk/spacewalk-setup-jabberd/spacewalk-setup-jabberd.spec index 3fee8a8..683099d 100644 --- a/spacewalk/spacewalk-setup-jabberd/spacewalk-setup-jabberd.spec +++ b/spacewalk/spacewalk-setup-jabberd/spacewalk-setup-jabberd.spec @@ -1,5 +1,5 @@ Name: spacewalk-setup-jabberd -Version: 1.6.3 +Version: 1.6.4 Release: 1%{?dist} Summary: Tools to setup jabberd for Spacewalk Group: Applications/System @@ -59,6 +59,9 @@ rm -rf %{buildroot} %dir %{_sysconfdir}/pki/spacewalk/jabberd %changelog +* Wed Oct 26 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 1.6.4-1 +- s2s.xml: no need to setup /s2s/local/resolver + * Wed Oct 19 2011 Milan Zazrivec <mzazrivec(a)redhat.com> 1.6.3-1 - spacewalk-setup-jabberd: update router.xml configuration commit 337e28fa8abb225c4cdba01a818fce56a6634dce Author: Milan Zazrivec <mzazrivec(a)redhat.com> Date: Wed Oct 26 11:18:32 2011 +0200 s2s.xml: no need to setup /s2s/local/resolver resolver component is not used in jabberd infrastructure anymore. diff --git a/spacewalk/spacewalk-setup-jabberd/share/jabberd/s2s.xsl b/spacewalk/spacewalk-setup-jabberd/share/jabberd/s2s.xsl index 5195fa6..ef9f4bc 100644 --- a/spacewalk/spacewalk-setup-jabberd/share/jabberd/s2s.xsl +++ b/spacewalk/spacewalk-setup-jabberd/share/jabberd/s2s.xsl @@ -20,25 +20,6 @@ </xsl:copy> </xsl:template> -<xsl:template match="/s2s/local"> - <xsl:copy> - <xsl:if test="not(resolver)"> - <xsl:text> - </xsl:text> - <xsl:comment> - Helper DNS resolver component - if this component is not - connected, dialback connections will fail - (default: resolver) </xsl:comment> - <xsl:text> - </xsl:text> - <resolver>resolver</resolver> - <xsl:text> - </xsl:text> - </xsl:if> - <xsl:apply-templates select="@*|node()" /> - </xsl:copy> -</xsl:template> - <xsl:template match="/s2s/check/interval"> <xsl:copy>3</xsl:copy> </xsl:template> commit 61b9fc4ea2d1b7c901d63810603e691d1e64398b Author: Martin Minar <mminar(a)redhat.com> Date: Wed Oct 26 10:25:53 2011 +0200 Automatic commit of package [spacewalk-java] release [1.6.66-1]. diff --git a/java/spacewalk-java.spec b/java/spacewalk-java.spec index b7cce5f..cc8f5dc 100644 --- a/java/spacewalk-java.spec +++ b/java/spacewalk-java.spec @@ -17,7 +17,7 @@ Name: spacewalk-java Summary: Spacewalk Java site packages Group: Applications/Internet License: GPLv2 -Version: 1.6.65 +Version: 1.6.66 Release: 1%{?dist} URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz @@ -557,6 +557,15 @@ fi %{jardir}/postgresql-jdbc.jar %changelog +* Wed Oct 26 2011 Martin Minar <mminar(a)redhat.com> 1.6.66-1 +- 737838 - allow org admins to unschedule repo sync (org tasks) + (tlestach(a)redhat.com) +- 692357 - clone also kernel and kernel post options when cloning a ks profile + (tlestach(a)redhat.com) +- DISTINCT is equivalent to UNIQUE. (jpazdziora(a)redhat.com) +- 726114 - allow macro delimiters in configchannel.createOrUpdatePath for + directories (tlestach(a)redhat.com) + * Tue Oct 25 2011 Jan Pazdziora 1.6.65-1 - 682845 - get rid of ChannelFactory.lookupContentSource(id) method without org param (tlestach(a)redhat.com) diff --git a/rel-eng/packages/spacewalk-java b/rel-eng/packages/spacewalk-java index 094d9a6..df7ac70 100644 --- a/rel-eng/packages/spacewalk-java +++ b/rel-eng/packages/spacewalk-java @@ -1 +1 @@ -1.6.65-1 java/ +1.6.66-1 java/ commit 902c2b06339ca736c68223c4af8a4db6688e3031 Author: Tomas Lestach <tlestach(a)redhat.com> Date: Tue Oct 25 16:01:11 2011 +0200 737838 - allow org admins to unschedule repo sync (org tasks) diff --git a/java/code/src/com/redhat/rhn/taskomatic/TaskomaticApi.java b/java/code/src/com/redhat/rhn/taskomatic/TaskomaticApi.java index 036f8b1..865d5b9 100644 --- a/java/code/src/com/redhat/rhn/taskomatic/TaskomaticApi.java +++ b/java/code/src/com/redhat/rhn/taskomatic/TaskomaticApi.java @@ -15,6 +15,7 @@ package com.redhat.rhn.taskomatic; import com.redhat.rhn.common.conf.ConfigDefaults; +import com.redhat.rhn.common.security.PermissionException; import com.redhat.rhn.common.validator.ValidatorException; import com.redhat.rhn.domain.channel.Channel; import com.redhat.rhn.domain.role.RoleFactory; @@ -137,6 +138,12 @@ public class TaskomaticApi { } } + private void ensureOrgAdminRole(User user) { + if (!user.hasRole(RoleFactory.ORG_ADMIN)) { + throw new PermissionException(RoleFactory.ORG_ADMIN); + } + } + /** * Creates a new schedule, unschedules, if en existing is defined * @param user shall be sat admin @@ -167,7 +174,7 @@ public class TaskomaticApi { } private void unscheduleTask(String jobLabel, User user) { - ensureSatAdminRole(user); + ensureOrgAdminRole(user); invoke("tasko.unscheduleBunch", user.getOrg().getId(), jobLabel); } commit db2a5b89b1e425f7bae5958c46a9440f18b78224 Author: Tomas Lestach <tlestach(a)redhat.com> Date: Tue Oct 25 15:34:18 2011 +0200 692357 - clone also kernel and kernel post options when cloning a ks profile diff --git a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartCloneCommand.java b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartCloneCommand.java index 684614c..d91a93f 100644 --- a/java/code/src/com/redhat/rhn/manager/kickstart/KickstartCloneCommand.java +++ b/java/code/src/com/redhat/rhn/manager/kickstart/KickstartCloneCommand.java @@ -67,6 +67,8 @@ public class KickstartCloneCommand extends BaseKickstartCommand { cloned.setVirtFileSize(((Integer) original.getVirtFileSize())); cloned.setVirtBridge(original.getVirtBridge()); cloned.setVirtPath(original.getVirtBridge()); + cloned.setKernelOptions(original.getKernelOptions()); + cloned.setKernelPostOptions(original.getKernelPostOptions()); cloned.save(); return null; commit 0005d41368a0770c4539fb9c46aa818121ea0a5c Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 13:55:51 2011 +0200 DISTINCT is equivalent to UNIQUE. Addressing ERROR com.redhat.rhn.common.db.datasource.CachedStatement - Error while processing cached statement sql: select unique c.id, c.label, c.name, [...] and rhn_channel.loose_user_role_check(c.id, ?, 'subscribe') = 1 com.redhat.rhn.common.db.WrappedSQLException: ERROR: syntax error at or near "c" diff --git a/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml b/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml index 28c0613..d04f5f5 100644 --- a/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml +++ b/java/code/src/com/redhat/rhn/common/db/datasource/xml/Channel_queries.xml @@ -767,7 +767,7 @@ SELECT C.id, C.name, C.label, 1 AS IS_CUSTOM <mode name="base_eus_channels_by_version_channel_arch" class="com.redhat.rhn.frontend.dto.EssentialChannelDto"> <query params="product_name_label, version, channel_arch_id, user_id, org_id"> - select unique c.id, + select distinct c.id, c.label, c.name, rcm.release, commit b2d853d936282ff228b8a9d2edff60523275d2ae Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 10:58:27 2011 +0200 Adding releasers.conf for the upcoming tito version. diff --git a/rel-eng/releasers.conf b/rel-eng/releasers.conf new file mode 100644 index 0000000..be89eee --- /dev/null +++ b/rel-eng/releasers.conf @@ -0,0 +1,3 @@ +[koji] +releaser = spacewalkx.releasex.KojiReleaserGit +autobuild_tags = dist-5E-sw-1.6-candidate dist-6E-sw-1.6-candidate dist-f14-sw-1.6-candidate dist-f15-sw-1.6-candidate commit 6d89779cf6bdc69a8480e39efe7fd58624b3558a Author: Tomas Lestach <tlestach(a)redhat.com> Date: Tue Oct 25 10:50:28 2011 +0200 726114 - allow macro delimiters in configchannel.createOrUpdatePath for directories to behave according to the documentation: (ignored if working with a directory) diff --git a/java/code/src/com/redhat/rhn/frontend/xmlrpc/configchannel/ConfigChannelHandler.java b/java/code/src/com/redhat/rhn/frontend/xmlrpc/configchannel/ConfigChannelHandler.java index d4ddae9..4a388eb 100644 --- a/java/code/src/com/redhat/rhn/frontend/xmlrpc/configchannel/ConfigChannelHandler.java +++ b/java/code/src/com/redhat/rhn/frontend/xmlrpc/configchannel/ConfigChannelHandler.java @@ -382,10 +382,8 @@ public class ConfigChannelHandler extends BaseHandler { validKeys.add(ConfigRevisionSerializer.PERMISSIONS); validKeys.add(ConfigRevisionSerializer.REVISION); validKeys.add(ConfigRevisionSerializer.SELINUX_CTX); - if (!isDir) { - validKeys.add(ConfigRevisionSerializer.MACRO_START); - validKeys.add(ConfigRevisionSerializer.MACRO_END); - } + validKeys.add(ConfigRevisionSerializer.MACRO_START); + validKeys.add(ConfigRevisionSerializer.MACRO_END); validateMap(validKeys, data); if (data.get(ConfigRevisionSerializer.SELINUX_CTX) == null) { commit 606a9ee62d0c3d7b773dae3edf33d3d6435040ba Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Tue Oct 25 10:41:46 2011 +0200 Automatic commit of package [spacewalk-java] release [1.6.65-1]. diff --git a/java/spacewalk-java.spec b/java/spacewalk-java.spec index a0ef9af..b7cce5f 100644 --- a/java/spacewalk-java.spec +++ b/java/spacewalk-java.spec @@ -17,7 +17,7 @@ Name: spacewalk-java Summary: Spacewalk Java site packages Group: Applications/Internet License: GPLv2 -Version: 1.6.64 +Version: 1.6.65 Release: 1%{?dist} URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz @@ -557,6 +557,16 @@ fi %{jardir}/postgresql-jdbc.jar %changelog +* Tue Oct 25 2011 Jan Pazdziora 1.6.65-1 +- 682845 - get rid of ChannelFactory.lookupContentSource(id) method without org + param (tlestach(a)redhat.com) +- 682845 - get rid of ChannelFactory.lookupContentSource(label) method without + org param (tlestach(a)redhat.com) +- Amending incorrect substitution from ee3623222bf. (slukasik(a)redhat.com) +- 682845 - fix apidoc of repository related APIs (tlestach(a)redhat.com) +- Do not hardcode config identifier, use defaults instead. + (slukasik(a)redhat.com) + * Mon Oct 24 2011 Simon Lukasik <slukasik(a)redhat.com> 1.6.64-1 - No need to have separate configuration per Tomcat's version (slukasik(a)redhat.com) diff --git a/rel-eng/packages/spacewalk-java b/rel-eng/packages/spacewalk-java index fa499c0..094d9a6 100644 --- a/rel-eng/packages/spacewalk-java +++ b/rel-eng/packages/spacewalk-java @@ -1 +1 @@ -1.6.64-1 java/ +1.6.65-1 java/ commit 9c96ce0392c8ffe76b768e188cb458c7b4d40b3c Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 21:03:27 2011 +0200 Automatic commit of package [spacewalk-proxy-installer] release [1.6.6-1]. diff --git a/proxy/installer/spacewalk-proxy-installer.spec b/proxy/installer/spacewalk-proxy-installer.spec index ae956a1..a56a807 100644 --- a/proxy/installer/spacewalk-proxy-installer.spec +++ b/proxy/installer/spacewalk-proxy-installer.spec @@ -2,7 +2,7 @@ Name: spacewalk-proxy-installer Summary: Spacewalk Proxy Server Installer Group: Applications/Internet License: GPLv2 -Version: 1.6.5 +Version: 1.6.6 Release: 1%{?dist} URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz @@ -84,6 +84,10 @@ rm -rf $RPM_BUILD_ROOT %doc LICENSE answers.txt %changelog +* Mon Oct 24 2011 Miroslav SuchÃœ 1.6.6-1 +- increase maximum_object_size_in_memory +- comment some squid directives + * Wed Sep 21 2011 Miroslav SuchÃœ 1.6.5-1 - 737853 - if rhn-ca-openssl.cnf does not exist, then check should succeed - 737853 - do not print output of awk, we care just about exit code diff --git a/rel-eng/packages/spacewalk-proxy-installer b/rel-eng/packages/spacewalk-proxy-installer index ca088ae..e6adfab 100644 --- a/rel-eng/packages/spacewalk-proxy-installer +++ b/rel-eng/packages/spacewalk-proxy-installer @@ -1 +1 @@ -1.6.5-1 proxy/installer/ +1.6.6-1 proxy/installer/ commit 0f1387292fec752e7eba8ff46d3cc998ec626dd0 Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 21:00:33 2011 +0200 increase maximum_object_size_in_memory it is old value, squid now has default 512 kB, we can allow even more as everybody has probably now lots of memory diff --git a/proxy/installer/squid.conf b/proxy/installer/squid.conf index a0fabab..baa755f 100644 --- a/proxy/installer/squid.conf +++ b/proxy/installer/squid.conf @@ -7,7 +7,7 @@ http_port 8080 cache_mem 400 MB maximum_object_size 200 MB -maximum_object_size_in_memory 128 KB +maximum_object_size_in_memory 1024 KB access_log /var/log/squid/access.log squid commit 89691aa73b5adf2c24616189289b8300c03af89d Author: Miroslav SuchÃœ <msuchy(a)redhat.com> Date: Mon Oct 24 20:56:10 2011 +0200 comment some squid directives diff --git a/proxy/installer/squid.conf b/proxy/installer/squid.conf index ed5d889..a0fabab 100644 --- a/proxy/installer/squid.conf +++ b/proxy/installer/squid.conf @@ -18,13 +18,19 @@ cache_dir ufs /var/spool/squid 15000 16 256 # cache can hold. The default is 13 KB. store_avg_object_size 817 KB +# We want to keep the largest objects around longer, and just download the smaller objects if we can. cache_replacement_policy heap LFUDA + memory_replacement_policy heap GDSF +# cache repodata only few minutes and then query parent whether it is fresh refresh_pattern /XMLRPC/GET-REQ/.*/repodata/.*\.xml.*$ 0 1% 525960 +# rpm will hardly ever change, force to chache it for very long time refresh_pattern \.rpm$ 10080 100% 525960 override-expire override-lastmod ignore-reload reload-into-ims refresh_pattern . 0 100% 525960 +# secure squid +# allow request only from localhost and to http and https ports acl all src 0.0.0.0/0.0.0.0 acl localhost src 127.0.0.1/32 acl SSL_ports port 443 @@ -39,9 +45,13 @@ http_access deny all icp_access allow all miss_access allow all +# if transport is canceled, finish downloading anyway quick_abort_pct -1 quick_abort_min -1 KB +# when range is required, download whole file anyway +# when we request rpm header, we will nearly always get +# request for the rest of the file range_offset_limit -1 KB # we download only from 1 server, default is 1024 commit 33483a84114e64936203a538580896d919a704b6 Author: Aron Parsons <parsonsa(a)bit-sys.com> Date: Mon Oct 24 13:43:43 2011 -0400 Automatic commit of package [spacecmd] release [1.6.6-1]. diff --git a/rel-eng/packages/spacecmd b/rel-eng/packages/spacecmd index b88d0ba..197304b 100644 --- a/rel-eng/packages/spacecmd +++ b/rel-eng/packages/spacecmd @@ -1 +1 @@ -1.6.5-1 spacecmd/ +1.6.6-1 spacecmd/ diff --git a/spacecmd/spacecmd.spec b/spacecmd/spacecmd.spec index 84427a4..3a908cd 100644 --- a/spacecmd/spacecmd.spec +++ b/spacecmd/spacecmd.spec @@ -4,7 +4,7 @@ %endif Name: spacecmd -Version: 1.6.5 +Version: 1.6.6 Release: 1%{?dist} Summary: Command-line interface to Spacewalk and Satellite servers @@ -61,6 +61,9 @@ touch %{buildroot}/%{python_sitelib}/spacecmd/__init__.py %doc %{_mandir}/man1/spacecmd.1.gz %changelog +* Mon Oct 24 2011 Aron Parsons <parsonsa(a)bit-sys.com> 1.6.6-1 +- spacecmd: use correct variable in system_reboot (parsonsa(a)bit-sys.com) + * Wed Sep 28 2011 Aron Parsons <parsonsa(a)bit-sys.com> 1.6.5-1 - spacecmd: wrong argument in distribution_create help message (parsonsa@bit- sys.com) commit 5c3e0cfba3738ad02b758751524a11c1008e2f9a Author: Aron Parsons <parsonsa(a)bit-sys.com> Date: Mon Oct 24 13:43:14 2011 -0400 spacecmd: use correct variable in system_reboot diff --git a/spacecmd/src/lib/system.py b/spacecmd/src/lib/system.py index cd54c54..ccc00b7 100644 --- a/spacecmd/src/lib/system.py +++ b/spacecmd/src/lib/system.py @@ -175,7 +175,7 @@ def do_system_reboot(self, args): system_id = self.get_system_id(system) if not system_id: continue - self.client.system.scheduleReboot(self.session, id, action_time) + self.client.system.scheduleReboot(self.session, system_id, action_time) #################### commit da076f44e18e1e446966df03788d3806f335f23b Author: Tomas Lestach <tlestach(a)redhat.com> Date: Mon Oct 24 15:30:12 2011 +0200 682845 - get rid of ChannelFactory.lookupContentSource(id) method without org param diff --git a/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java b/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java index a551e53..7c338ca 100644 --- a/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java +++ b/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java @@ -118,18 +118,6 @@ public class ChannelFactory extends HibernateFactory { } /** - * Lookup a content source by id - * @param id the id to lookup - * @return the ContentSource - */ - public static ContentSource lookupContentSource(Long id) { - Map params = new HashMap(); - params.put("id", id); - return (ContentSource) singleton.lookupObjectByNamedQuery( - "ContentSource.findById", params); - } - - /** * Lookup a content source by org * @param org the org to lookup * @return the ContentSource(s) diff --git a/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml b/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml index 6c36fc6..c4bd583 100644 --- a/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml +++ b/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml @@ -41,9 +41,6 @@ PUBLIC "-//Hibernate/Hibernate Mapping DTD 3.0//EN" <query name="ContentSource.findByIdandOrg"> <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.id = :id and c.org = :org]]> </query> - <query name="ContentSource.findById"> - <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.id = :id]]> - </query> <query name="ContentSource.findByOrg"> <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.org = :org]]> </query> diff --git a/java/code/src/com/redhat/rhn/frontend/action/channel/manage/RepositoriesAction.java b/java/code/src/com/redhat/rhn/frontend/action/channel/manage/RepositoriesAction.java index e707762..18a6056 100644 --- a/java/code/src/com/redhat/rhn/frontend/action/channel/manage/RepositoriesAction.java +++ b/java/code/src/com/redhat/rhn/frontend/action/channel/manage/RepositoriesAction.java @@ -88,7 +88,7 @@ public class RepositoriesAction extends RhnAction implements Listable { Set <String> set = helper.getSet(); for (String id : set) { Long sgid = Long.valueOf(id); - ContentSource tmp = ChannelFactory.lookupContentSource(sgid); + ContentSource tmp = ChannelFactory.lookupContentSource(sgid, user.getOrg()); foo.add(tmp); } diff --git a/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java b/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java index 9fd893b..48aaff8 100644 --- a/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java +++ b/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java @@ -2390,7 +2390,8 @@ public class ChannelSoftwareHandler extends BaseHandler { **/ public Integer removeRepo(String sessionKey, Integer id) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue())); + ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue()), + user.getOrg()); ChannelFactory.remove(repo); return 1; @@ -2485,7 +2486,8 @@ public class ChannelSoftwareHandler extends BaseHandler { **/ public ContentSource updateRepoUrl(String sessionKey, Integer id, String url) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue())); + ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue()), + user.getOrg()); repo.setSourceUrl(url); ChannelFactory.save(repo); return repo; @@ -2528,7 +2530,8 @@ public class ChannelSoftwareHandler extends BaseHandler { **/ public ContentSource updateRepoLabel(String sessionKey, Integer id, String label) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue())); + ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue()), + user.getOrg()); repo.setLabel(label); ChannelFactory.save(repo); return repo; @@ -2552,7 +2555,8 @@ public class ChannelSoftwareHandler extends BaseHandler { public ContentSource updateRepo(String sessionKey, Integer id, String label, String url) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue())); + ContentSource repo = ChannelFactory.lookupContentSource(new Long(id.longValue()), + user.getOrg()); repo.setLabel(label); repo.setSourceUrl(url); ChannelFactory.save(repo); @@ -2589,7 +2593,8 @@ public class ChannelSoftwareHandler extends BaseHandler { * $ContentSourceSerializer */ public ContentSource getRepoDetails(String sessionKey, Integer id) { - return ChannelFactory.lookupContentSource(new Long(id.longValue())); + User user = getLoggedInUser(sessionKey); + return ChannelFactory.lookupContentSource(new Long(id.longValue()), user.getOrg()); } /** commit 2d9649abe87b899e976992491e1faa6e4c39b5f5 Author: Tomas Lestach <tlestach(a)redhat.com> Date: Mon Oct 24 14:55:36 2011 +0200 682845 - get rid of ChannelFactory.lookupContentSource(label) method without org param diff --git a/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java b/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java index 24467c3..a551e53 100644 --- a/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java +++ b/java/code/src/com/redhat/rhn/domain/channel/ChannelFactory.java @@ -130,18 +130,6 @@ public class ChannelFactory extends HibernateFactory { } /** - * Lookup a content source by label - * @param label the label to lookup - * @return the ContentSource - */ - public static ContentSource lookupContentSource(String label) { - Map params = new HashMap(); - params.put("label", label); - return (ContentSource) singleton.lookupObjectByNamedQuery( - "ContentSource.findByLabel", params); - } - - /** * Lookup a content source by org * @param org the org to lookup * @return the ContentSource(s) @@ -173,12 +161,12 @@ public class ChannelFactory extends HibernateFactory { * @param label repo label * @return the ContentSource(s) */ - public static List<ContentSource> lookupContentSourceByOrgAndLabel(Org org, + public static ContentSource lookupContentSourceByOrgAndLabel(Org org, String label) { Map params = new HashMap(); params.put("org", org); params.put("label", label); - return singleton.listObjectsByNamedQuery( + return (ContentSource) singleton.lookupObjectByNamedQuery( "ContentSource.findByOrgAndLabel", params); } diff --git a/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml b/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml index 79ad517..6c36fc6 100644 --- a/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml +++ b/java/code/src/com/redhat/rhn/domain/channel/ContentSource.hbm.xml @@ -44,9 +44,6 @@ PUBLIC "-//Hibernate/Hibernate Mapping DTD 3.0//EN" <query name="ContentSource.findById"> <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.id = :id]]> </query> - <query name="ContentSource.findByLabel"> - <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.label = :label]]> - </query> <query name="ContentSource.findByOrg"> <![CDATA[from com.redhat.rhn.domain.channel.ContentSource as c where c.org = :org]]> </query> diff --git a/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java b/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java index 4076167..9fd893b 100644 --- a/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java +++ b/java/code/src/com/redhat/rhn/frontend/xmlrpc/channel/software/ChannelSoftwareHandler.java @@ -2372,7 +2372,8 @@ public class ChannelSoftwareHandler extends BaseHandler { repoCmd.store(); - ContentSource repo = ChannelFactory.lookupContentSource(label); + ContentSource repo = ChannelFactory.lookupContentSourceByOrgAndLabel( + user.getOrg(), label); return repo; } @@ -2408,7 +2409,8 @@ public class ChannelSoftwareHandler extends BaseHandler { **/ public Integer removeRepo(String sessionKey, String label) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(label); + ContentSource repo = ChannelFactory.lookupContentSourceByOrgAndLabel(user.getOrg(), + label); ChannelFactory.remove(repo); return 1; @@ -2430,7 +2432,8 @@ public class ChannelSoftwareHandler extends BaseHandler { public Channel associateRepo(String sessionKey, String chanLabel, String repoLabel) { User user = getLoggedInUser(sessionKey); Channel channel = lookupChannelByLabel(user, chanLabel); - ContentSource repo = ChannelFactory.lookupContentSource(repoLabel); + ContentSource repo = ChannelFactory.lookupContentSourceByOrgAndLabel(user.getOrg(), + repoLabel); Set<ContentSource> set = channel.getSources(); set.add(repo); @@ -2455,7 +2458,8 @@ public class ChannelSoftwareHandler extends BaseHandler { public Channel disassociateRepo(String sessionKey, String chanLabel, String repoLabel) { User user = getLoggedInUser(sessionKey); Channel channel = lookupChannelByLabel(user, chanLabel); - ContentSource repo = ChannelFactory.lookupContentSource(repoLabel); + ContentSource repo = ChannelFactory.lookupContentSourceByOrgAndLabel(user.getOrg(), + repoLabel); Set<ContentSource> set = channel.getSources(); set.remove(repo); @@ -2502,7 +2506,8 @@ public class ChannelSoftwareHandler extends BaseHandler { **/ public ContentSource updateRepoUrl(String sessionKey, String label, String url) { User user = getLoggedInUser(sessionKey); - ContentSource repo = ChannelFactory.lookupContentSource(label); + ContentSource repo = ChannelFactory.lookupContentSourceByOrgAndLabel(user.getOrg(), + label); repo.setSourceUrl(url); ChannelFactory.save(repo); return repo; @@ -2567,7 +2572,8 @@ public class ChannelSoftwareHandler extends BaseHandler { * $ContentSourceSerializer */ public ContentSource getRepoDetails(String sessionKey, String repoLabel) { - return ChannelFactory.lookupContentSource(repoLabel); + User user = getLoggedInUser(sessionKey); + return ChannelFactory.lookupContentSourceByOrgAndLabel(user.getOrg(), repoLabel); } /** diff --git a/java/code/src/com/redhat/rhn/manager/channel/repo/BaseRepoCommand.java b/java/code/src/com/redhat/rhn/manager/channel/repo/BaseRepoCommand.java index 849459e..b0b9050 100644 --- a/java/code/src/com/redhat/rhn/manager/channel/repo/BaseRepoCommand.java +++ b/java/code/src/com/redhat/rhn/manager/channel/repo/BaseRepoCommand.java @@ -102,7 +102,7 @@ public class BaseRepoCommand { repo.setType(ChannelFactory.CONTENT_SOURCE_TYPE_YUM); if (!this.label.equals(repo.getLabel())) { - if (!ChannelFactory.lookupContentSourceByOrgAndLabel(org, label).isEmpty()) { + if (ChannelFactory.lookupContentSourceByOrgAndLabel(org, label) != null) { throw new InvalidRepoLabelException(label); } repo.setLabel(this.label); commit 14d4904104d39eee51cc2093ec32e56eaee5d2e7 Author: Michael Mraka <michael.mraka(a)redhat.com> Date: Mon Oct 24 16:16:09 2011 +0200 Automatic commit of package [spacewalk-backend] release [1.6.35-1]. diff --git a/backend/spacewalk-backend.spec b/backend/spacewalk-backend.spec index 21006be..6bfc9d6 100644 --- a/backend/spacewalk-backend.spec +++ b/backend/spacewalk-backend.spec @@ -12,7 +12,7 @@ Name: spacewalk-backend Summary: Common programs needed to be installed on the Spacewalk servers/proxies Group: Applications/Internet License: GPLv2 and Python -Version: 1.6.34 +Version: 1.6.35 Release: 1%{?dist} URL: https://fedorahosted.org/spacewalk Source0: https://fedorahosted.org/releases/s/p/spacewalk/%{name}-%{version}.tar.gz @@ -675,6 +675,9 @@ rm -f %{rhnconf}/rhnSecret.py* # $Id$ %changelog +* Mon Oct 24 2011 Michael Mraka <michael.mraka(a)redhat.com> 1.6.35-1 +- 731692 - make number formating consistent across all units + * Tue Oct 18 2011 Miroslav SuchÃœ 1.6.34-1 - 745102 - unify handlers of nullable columns diff --git a/rel-eng/packages/spacewalk-backend b/rel-eng/packages/spacewalk-backend index 672d321..681cdfe 100644 --- a/rel-eng/packages/spacewalk-backend +++ b/rel-eng/packages/spacewalk-backend @@ -1 +1 @@ -1.6.34-1 backend/ +1.6.35-1 backend/ commit 17655a026da3c251857ed2da575f5b137ee5aee0 Author: Michael Mraka <michael.mraka(a)redhat.com> Date: Mon Oct 24 13:56:18 2011 +0200 731692 - make number formating consistent across all units diff --git a/backend/satellite_tools/satsync.py b/backend/satellite_tools/satsync.py index f41ff45..e93d0c5 100644 --- a/backend/satellite_tools/satsync.py +++ b/backend/satellite_tools/satsync.py @@ -1807,19 +1807,17 @@ Please contact your RHN representative""") % (generation, sat_cert.generation)) # Translate x bytes to string "x MB", "x GB" or "x kB" def _bytes_to_fuzzy(self, bytes): - kilo=1024 - mega=kilo*1024 - giga=mega*1024 - if (bytes/kilo == 0): - return "%d bytes" %(bytes) - elif (bytes/mega == 0): - return "%d kiB" %(bytes / 1024) - elif (bytes/giga == 0): - mega_value=float(bytes) / mega - return "%.3f MiB" %(mega_value) - else: - giga_value=float(bytes) / giga - return "%.3f GiB" %(giga_value) + units = [ 'bytes', 'kiB', 'MiB', 'GiB', 'TiB', 'PiB'] + base = 1024 + fuzzy = bytes + for unit in units: + if fuzzy >= base: + fuzzy = float(fuzzy)/base + else: + break + int_len = len("%d" % fuzzy) + fract_len = 3 - int_len + return "%*.*f %s" % (int_len, fract_len, fuzzy, unit) def _get_package_stream(self, channel, package_id, nvrea, sources): """ returns (filepath, stream), so in the case of a "wire source", commit f59861774f13cd6703b9c781b0e9a911108bf5bb Author: Michael Mraka <michael.mraka(a)redhat.com> Date: Mon Oct 24 12:55:36 2011 +0200 731692 - do the decimal part math properly diff --git a/backend/satellite_tools/satsync.py b/backend/satellite_tools/satsync.py index 972ed2f..f41ff45 100644 --- a/backend/satellite_tools/satsync.py +++ b/backend/satellite_tools/satsync.py @@ -1815,11 +1815,11 @@ Please contact your RHN representative""") % (generation, sat_cert.generation)) elif (bytes/mega == 0): return "%d kiB" %(bytes / 1024) elif (bytes/giga == 0): - mega_value=bytes / mega - return "%d.%03d MiB" %(mega_value, (bytes % mega) / kilo) + mega_value=float(bytes) / mega + return "%.3f MiB" %(mega_value) else: - giga_value=bytes / giga - return "%d.%03d GiB" %(giga_value, (bytes % giga) / mega) + giga_value=float(bytes) / giga + return "%.3f GiB" %(giga_value) def _get_package_stream(self, channel, package_id, nvrea, sources): """ returns (filepath, stream), so in the case of a "wire source", commit f7119227dbb956bfe080c70d138827497ad58784 Author: Jan Pazdziora <jpazdziora(a)redhat.com> Date: Mon Oct 24 15:24:15 2011 +0200 Removing Perl modulex that are (in newer versions) on CPAN. diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/BUILD b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/BUILD deleted file mode 100644 index 5b87bf0..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/BUILD +++ /dev/null @@ -1,53 +0,0 @@ -# Macros - -%define cvs_package PerlModules/CPAN/Crypt-Blowfish-2.09 - -# Package specific stuff -Name: Crypt-Blowfish -Version: 2.11.1 -Release: 1 -Packager: Nick Hansen <nhansen(a)redhat.com> -Summary: Perl Blowfish encryption -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: i386 -Requires: perl -Requires: %(perl -MConfig -le 'if (defined $Config{useithreads}) { print "perl(:WITH_ITHREADS)" } else { print "perl(:WITHOUT_ITHREADS)" }') -Requires: %(perl -MConfig -le 'if (defined $Config{usethreads}) { print "perl(:WITH_THREADS)" } else { print "perl(:WITHOUT_THREADS)" }') -Requires: %(perl -MConfig -le 'if (defined $Config{uselargefiles}) { print "perl(:WITH_LARGEFILES)" } else { print "perl(:WITHOUT_LARGEFILES)" }') -Group: Development/Libraries -Vendor: Red Hat, Inc. -Copyright: This perl extension includes software developed by, and copyright of, A.M. Kuchling. Other parts of the library are covered by the following licence: Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) Modifications and Current Implimentation Copyright (C) 2000 W3Works, LLC. All rights reserved. - -BuildRoot: %{_tmppath}/%name -Prefix: %{_our_prefix} - - -%description - -This is Crypt::Blowfish version 2.09, an XS-based implementation of the -Blowfish cryptography algorithm designed by Bruce Schneier. It's designed -to take full advantage of Crypt::CBC when desired. Blowfish keys may be -up to 448 bits (56 bytes) long. This module builds on nearly every platform -that Perl itself does (see Notes for exceptions). - - -%prep -%entirely_abstract_build_step - -%build -%makefile_build - -%install -rm -rf $RPM_BUILD_ROOT -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION - -%cpan_doc_install -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - -%files -f %{name}-%{version}-%{release}-filelist - -%clean -%abstract_clean_script - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.bs b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.bs deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.c b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.c deleted file mode 100644 index 5b67485..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.c +++ /dev/null @@ -1,117 +0,0 @@ -/* - * This file was generated automatically by xsubpp version 1.9507 from the - * contents of Blowfish.xs. Do not edit this file, edit Blowfish.xs instead. - * - * ANY CHANGES MADE HERE WILL BE LOST! - * - */ - -#line 1 "Blowfish.xs" -/* - * Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) - * - * Code Modfifications Copyright (C) 2000 W3Works, LLC (http://www.w3works.co/) - * All rights reserved. - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "blowfish.h" - -/* thanks to LDS */ -#ifndef sv_undef -#define sv_undef PL_sv_undef -#endif - -#line 29 "Blowfish.c" -XS(XS_Crypt__Blowfish_init) -{ - dXSARGS; - if (items != 1) - croak("Usage: Crypt::Blowfish::init(key)"); - { - unsigned char * key; - STRLEN key_len; - char * RETVAL; -#line 29 "Blowfish.xs" - { - /* - * What should this length be??? - */ - char ks[8192]; - - key = (unsigned char *) SvPV(ST(0), key_len); - if (key_len < 8 || key_len > 56) - croak("Invalid length key"); - - if (blowfish_make_bfkey(key, key_len, ks)) - croak("Error creating key schedule"); - - ST(0) = sv_2mortal(newSVpv(ks, sizeof(ks))); - } -#line 55 "Blowfish.c" - } - XSRETURN(1); -} - -XS(XS_Crypt__Blowfish_crypt) -{ - dXSARGS; - if (items != 4) - croak("Usage: Crypt::Blowfish::crypt(input, output, ks, dir)"); - { - char * input; - SV * output = ST(1); - char * ks; - STRLEN input_len; - STRLEN output_len; - STRLEN ks_len; - int dir = (int)SvIV(ST(3)); -#line 55 "Blowfish.xs" - { - input = (char *) SvPV(ST(0), input_len); - if (input_len != 8) - croak("input must be 8 bytes long"); - - ks = (char *) SvPV(ST(2), ks_len); - - if (output == &sv_undef) - output = sv_newmortal(); - output_len = 8; - - if (!SvUPGRADE(output, SVt_PV)) - croak("cannot use output argument as lvalue"); - - /* blowfish_crypt_8bytes(input, SvGROW(output, 8), ks, dir); */ - /* HP-UX (HP cc) fix below, thanks Addi! */ - blowfish_crypt_8bytes( (unsigned char*)input, (unsigned char*)SvGROW(output, 8), ks, (short)dir); - - SvCUR_set(output, output_len); - *SvEND(output) = '\0'; - (void) SvPOK_only(output); - SvTAINT(output); - - ST(0) = output; - } -#line 99 "Blowfish.c" - } - XSRETURN(1); -} - -#ifdef __cplusplus -extern "C" -#endif -XS(boot_Crypt__Blowfish) -{ - dXSARGS; - char* file = __FILE__; - - XS_VERSION_BOOTCHECK ; - - newXS("Crypt::Blowfish::init", XS_Crypt__Blowfish_init, file); - newXS("Crypt::Blowfish::crypt", XS_Crypt__Blowfish_crypt, file); - XSRETURN_YES; -} - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.pm b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.pm deleted file mode 100644 index 9295a5a..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.pm +++ /dev/null @@ -1,207 +0,0 @@ -package Crypt::Blowfish; - -require Exporter; -require DynaLoader; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); - -@ISA = qw(Exporter DynaLoader); -# @ISA = qw(Exporter DynaLoader Crypt::BlockCipher); - -# Items to export into callers namespace by default -@EXPORT = qw(); - -# Other items we are prepared to export if requested -@EXPORT_OK = qw( - blocksize keysize min_keysize max_keysize - new encrypt decrypt -); - -$VERSION = '2.09'; -bootstrap Crypt::Blowfish $VERSION; - -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - - -sub blocksize { 8; } # /* byte my shiny metal.. */ -sub keysize { 0; } # /* we'll leave this at 8 .. for now. expect change. */ -sub min_keysize { 8; } -sub max_keysize { 56; } - -sub new -{ - usage("new Blowfish key") unless @_ == 2; - - my $type = shift; my $self = {}; bless $self, $type; - - $self->{'ks'} = Crypt::Blowfish::init(shift); - - $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 0); - - $data; -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 1); - - $data; -} - -1; - -__END__ -# -# Parts Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -# New Parts Copyright (C) 2000, 2001 W3Works, LLC (http://www.w3works.com/) -# All rights reserved. -# - -=head1 NAME - -Crypt::Blowfish - Perl Blowfish encryption module - -=head1 SYNOPSIS - - use Crypt::Blowfish; - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - my $plaintext = $cipher->decrypt($ciphertext); - -=head1 DESCRIPTION - -Blowfish is capable of strong encryption and can use key sizes up -to 56 bytes (a 448 bit key). You're encouraged to take advantage -of the full key size to ensure the strongest encryption possible -from this module. - -Crypt::Blowfish has the following methods: - -=over 4 - - blocksize() - keysize() - encrypt() - decrypt() - -=back - -=head1 FUNCTIONS - -=over 4 - -=item blocksize - -Returns the size (in bytes) of the block cipher. - -Crypt::Blowfish doesn't return a key size due to its ability -to use variable-length keys. (well, more accurately, it won't -as of 2.09 .. for now, it does. expect that to change) - -=item new - - my $cipher = new Crypt::Blowfish $key; - -This creates a new Crypt::Blowfish BlockCipher object, using $key, -where $key is a key of C<keysize()> bytes (minimum of eight bytes). - -=item encrypt - - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - -This function encrypts $plaintext and returns the $ciphertext -where $plaintext and $ciphertext must be of C<blocksize()> bytes. -(hint: Blowfish is an 8 byte block cipher) - -=item decrypt - - my $cipher = new Crypt::Blowfish $key; - my $plaintext = $cipher->decrypt($ciphertext); - -This function decrypts $ciphertext and returns the $plaintext -where $plaintext and $ciphertext must be of C<blocksize()> bytes. -(hint: see previous hint) - -=back - -=head1 EXAMPLE - - my $key = pack("H16", "0123456789ABCDEF"); # min. 8 bytes - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt("plaintex"); # SEE NOTES - print unpack("H16", $ciphertext), "\n"; - -=head1 PLATFORMS - - Please see the README document for platforms and performance - tests. - -=head1 NOTES - -The module is capable of being used with Crypt::CBC. You're -encouraged to read the perldoc for Crypt::CBC if you intend to -use this module for Cipher Block Chaining modes. In fact, if -you have any intentions of encrypting more than eight bytes of -data with this, or any other block cipher, you're going to need -B<some> type of block chaining help. Crypt::CBC tends to be -very good at this. If you're not going to encrypt more than -eight bytes, your data B<must> be B<exactly> eight bytes long. -If need be, do your own padding. "\0" as a null byte is perfectly -valid to use for this. Additionally, the current maintainer for -Crypt::Blowfish may or may not release Crypt::CBC_R which -replaces the default 'RandomIV' initialization vector in -Crypt::CBC with a random initialization vector. (to the limits -of /dev/urandom and associates) In either case, please email -amused(a)pobox.com for Crypt::CBC_R. - -=head1 SEE ALSO - -Crypt::CBC, -Crypt::DES, -Crypt::IDEA - -Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, -published by John Wiley & Sons, Inc. - -=head1 COPYRIGHT - -The implementation of the Blowfish algorithm was developed by, -and is copyright of, A.M. Kuchling. - -Other parts of the perl extension and module are -copyright of Systemics Ltd ( http://www.systemics.com/ ). - -Code revisions, updates, and standalone release are copyright -1999-2001 W3Works, LLC. - -=head1 AUTHOR - -Original algorithm, Bruce Shneier. Original implementation, A.M. -Kuchling. Original Perl implementation, Systemics Ltd. Current -maintenance by W3Works, LLC. - -Current revision and maintainer: Dave Paris <amused(a)pobox.com> - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.xs b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.xs deleted file mode 100644 index 336ac75..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Blowfish.xs +++ /dev/null @@ -1,79 +0,0 @@ -/* - * Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) - * - * Code Modfifications Copyright (C) 2000 W3Works, LLC (http://www.w3works.co/) - * All rights reserved. - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "blowfish.h" - -/* thanks to LDS */ -#ifndef sv_undef -#define sv_undef PL_sv_undef -#endif - -MODULE = Crypt::Blowfish PACKAGE = Crypt::Blowfish PREFIX = blowfish_ - -PROTOTYPES: DISABLE - - -char * -blowfish_init(key) - unsigned char * key = NO_INIT - STRLEN key_len = NO_INIT - CODE: - { - /* - * What should this length be??? - */ - char ks[8192]; - - key = (unsigned char *) SvPV(ST(0), key_len); - if (key_len < 8 || key_len > 56) - croak("Invalid length key"); - - if (blowfish_make_bfkey(key, key_len, ks)) - croak("Error creating key schedule"); - - ST(0) = sv_2mortal(newSVpv(ks, sizeof(ks))); - } - -void -blowfish_crypt(input, output, ks, dir) - char * input = NO_INIT - SV * output - char * ks = NO_INIT - STRLEN input_len = NO_INIT - STRLEN output_len = NO_INIT - STRLEN ks_len = NO_INIT - int dir - CODE: - { - input = (char *) SvPV(ST(0), input_len); - if (input_len != 8) - croak("input must be 8 bytes long"); - - ks = (char *) SvPV(ST(2), ks_len); - - if (output == &sv_undef) - output = sv_newmortal(); - output_len = 8; - - if (!SvUPGRADE(output, SVt_PV)) - croak("cannot use output argument as lvalue"); - - /* blowfish_crypt_8bytes(input, SvGROW(output, 8), ks, dir); */ - /* HP-UX (HP cc) fix below, thanks Addi! */ - blowfish_crypt_8bytes( (unsigned char*)input, (unsigned char*)SvGROW(output, 8), ks, (short)dir); - - SvCUR_set(output, output_len); - *SvEND(output) = '\0'; - (void) SvPOK_only(output); - SvTAINT(output); - - ST(0) = output; - } diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/COPYRIGHT b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/COPYRIGHT deleted file mode 100644 index 4eed66c..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/COPYRIGHT +++ /dev/null @@ -1,67 +0,0 @@ -This perl extension includes software developed by, and copyright of, A.M. Kuchling. - -Other parts of the library are covered by the following licence: - -Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) - -Modifications and Current Implimentation Copyright (C) 2000 W3Works, LLC. - -All rights reserved. - -Current implimentation contains modifications made by W3Works, LLC. The -modifications remain copyright of W3Works, LLC and attribution for these -modification should be made to W3Works, LLC. These modifications and -this copyright must remain with this package. - -Additions to the Restrictions set out below are: -1. All advertising materials mentioning features or use of this software - must display the following acknowledgement: - This product inculdes software developed by W3Works, LLC (http://www.w3works.com) - - NO ADDITIONAL WARRANTIES, EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, - THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE EXTENDED BY THIS DISTRIBUTION. - - Any subsequent derrivations of this package must retainl this copyright. - - -Original Copyright Below - -This library and applications are FREE FOR COMMERCIAL AND NON-COMMERCIAL USE -as long as the following conditions are adhered to. - -Copyright remains with Systemics Ltd, and as such any Copyright notices -in the code are not to be removed. If this code is used in a product, -Systemics should be given attribution as the author of the parts used. -This can be in the form of a textual message at program startup or -in documentation (online or textual) provided with the package. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. All advertising materials mentioning features or use of this software - must display the following acknowledgement: - This product includes software developed by Systemics Ltd (http://www.systemics.com/) - - THIS SOFTWARE IS PROVIDED BY SYSTEMICS LTD ``AS IS'' AND - ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE - FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS - OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) - HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF - SUCH DAMAGE. - - The licence and distribution terms for any publically available version or - derivative of this code cannot be changed. i.e. this code cannot simply be - copied and put under another distribution licence - [including the GNU Public Licence.] - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Changes b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Changes deleted file mode 100644 index b2821b8..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Changes +++ /dev/null @@ -1,48 +0,0 @@ -Revision history for Perl extension Crypt::Blowfish. - -2.09 Tue Nov 13 01:28:26 EST 2001 - - changed keysize back to 0 - apparently setting keysize to 8 triggered a bad hack - in Crypt::CBC which resulted in OpenSRS breaking. - the "bad hack" in question is: - $ks = $cipher =~ /blowfish/i ? 56 : 8 unless $ks > 0; - ... anyway.. fixed. - -2.08 Tue Oct 30 23:29:25 EST 2001 - - added two new functions: min_keysize and max_keysize - these allow modules like Crypt::CBC_IL and Crypt::CBC_R - to use variable key lengths with CBC modes. - - cleaned up test.pl - - updated README - -2.07 Thu Nov 30 02:59:29 EST 2000 - - minor change in XS - - additions to reported platforms - -2.06 Tue Jul 04 15:35:34 EST 2000 - - Win32 tested using VC++5.0, all tests passed on NT4/SP5 - -2.05 Tue Jul 04 14:42:13 EST 2000 - - non-public - - code-cleanup - - initial Win32 support - -2.04 Wed May 17 21:42:54 EST 2000 - - non-public - - code cleanup - -2.03 Tue Feb 29 17:19:48 EST 2000 - - added small patch from LDS to Blowfish.xs - -2.02 Sun Feb 13 21:49:58 EST 2000 - - added speed tests, fixed HP-UX functionality - - cleaned up code - - added README - -2.01 Fri Feb 11 19:35:27 EST 2000 - - solidified XS support and extracted - from original package. - -2.00 Sun Sep 5 21:07:48 EST 1999 - - original version; created by h2xs 1.19 - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/MANIFEST b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/MANIFEST deleted file mode 100644 index 6381a76..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/MANIFEST +++ /dev/null @@ -1,11 +0,0 @@ -COPYRIGHT -Blowfish.pm -Blowfish.xs -MANIFEST -README -Changes -Makefile.PL -_blowfish.c -blowfish.h -test.pl -typemap diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile deleted file mode 100644 index 101b597..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile +++ /dev/null @@ -1,759 +0,0 @@ -# This Makefile is for the Crypt::Blowfish extension to perl. -# -# It was generated automatically by MakeMaker version -# 5.4302 (Revision: 1.222) from the contents of -# Makefile.PL. Don't edit this file, edit Makefile.PL instead. -# -# ANY CHANGES MADE HERE WILL BE LOST! -# -# MakeMaker ARGV: () -# -# MakeMaker Parameters: - -# DISTNAME => q[Crypt-Blowfish] -# NAME => q[Crypt::Blowfish] -# OBJECT => q[Blowfish.o _blowfish.o] -# VERSION_FROM => q[Blowfish.pm] -# dist => { COMPRESS=>q[gzip], SUFFIX=>q[gz] } - -# --- MakeMaker post_initialize section: - - -# --- MakeMaker const_config section: - -# These definitions are from config.sh (via /usr/lib/perl5/5.00503/i386-linux/Config.pm) - -# They may have been overridden via Makefile.PL or on the command line -AR = ar -CC = cc -CCCDLFLAGS = -fpic -CCDLFLAGS = -rdynamic -DLEXT = so -DLSRC = dl_dlopen.xs -LD = cc -LDDLFLAGS = -shared -L/usr/local/lib -LDFLAGS = -L/usr/local/lib -LIBC = -LIB_EXT = .a -OBJ_EXT = .o -OSNAME = linux -OSVERS = 2.2.5-22smp -RANLIB = : -SO = so -EXE_EXT = - - -# --- MakeMaker constants section: -AR_STATIC_ARGS = cr -NAME = Crypt::Blowfish -DISTNAME = Crypt-Blowfish -NAME_SYM = Crypt_Blowfish -VERSION = 2.09 -VERSION_SYM = 2_09 -XS_VERSION = 2.09 -INST_BIN = blib/bin -INST_EXE = blib/script -INST_LIB = blib/lib -INST_ARCHLIB = blib/arch -INST_SCRIPT = blib/script -PREFIX = /usr -INSTALLDIRS = site -INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.00503 -INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.00503/i386-linux -INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.005 -INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.005/i386-linux -INSTALLBIN = $(PREFIX)/bin -INSTALLSCRIPT = $(PREFIX)/bin -PERL_LIB = /usr/lib/perl5/5.00503 -PERL_ARCHLIB = /usr/lib/perl5/5.00503/i386-linux -SITELIBEXP = /usr/lib/perl5/site_perl/5.005 -SITEARCHEXP = /usr/lib/perl5/site_perl/5.005/i386-linux -LIBPERL_A = libperl.a -FIRST_MAKEFILE = Makefile -MAKE_APERL_FILE = Makefile.aperl -PERLMAINCC = $(CC) -PERL_INC = /usr/lib/perl5/5.00503/i386-linux/CORE -PERL = /usr/bin/perl -FULLPERL = /usr/bin/perl - -VERSION_MACRO = VERSION -DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" -XS_VERSION_MACRO = XS_VERSION -XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" - -MAKEMAKER = /usr/lib/perl5/5.00503/ExtUtils/MakeMaker.pm -MM_VERSION = 5.4302 - -# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). -# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) -# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!! -# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar) -# DLBASE = Basename part of dynamic library. May be just equal BASEEXT. -FULLEXT = Crypt/Blowfish -BASEEXT = Blowfish -PARENT_NAME = Crypt -DLBASE = $(BASEEXT) -VERSION_FROM = Blowfish.pm -OBJECT = Blowfish$(OBJ_EXT) _blowfish$(OBJ_EXT) -LDFROM = $(OBJECT) -LINKTYPE = dynamic - -# Handy lists of source code files: -XS_FILES= Blowfish.xs -C_FILES = Blowfish.c \ - _blowfish.c -O_FILES = Blowfish.o \ - _blowfish.o -H_FILES = blowfish.h -MAN1PODS = -MAN3PODS = Blowfish.pm -INST_MAN1DIR = blib/man1 -INSTALLMAN1DIR = $(PREFIX)/man/man1 -MAN1EXT = 1 -INST_MAN3DIR = blib/man3 -INSTALLMAN3DIR = $(PREFIX)/lib/perl5/man/man3 -MAN3EXT = 3 -PERM_RW = 644 -PERM_RWX = 755 - -# work around a famous dec-osf make(1) feature(?): -makemakerdflt: all - -.SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT) - -# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that -# some make implementations will delete the Makefile when we rebuild it. Because -# we call false(1) when we rebuild it. So make(1) is not completely wrong when it -# does so. Our milage may vary. -# .PRECIOUS: Makefile # seems to be not necessary anymore - -.PHONY: all config static dynamic test linkext manifest - -# Where is the Config information that we are using/depend on -CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h - -# Where to put things: -INST_LIBDIR = $(INST_LIB)/Crypt -INST_ARCHLIBDIR = $(INST_ARCHLIB)/Crypt - -INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT) -INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT) - -INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT) -INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT) -INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs - -EXPORT_LIST = - -PERL_ARCHIVE = - -TO_INST_PM = Blowfish.pm - -PM_TO_BLIB = Blowfish.pm \ - $(INST_LIBDIR)/Blowfish.pm - - -# --- MakeMaker tool_autosplit section: - -# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto -AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;' - - -# --- MakeMaker tool_xsubpp section: - -XSUBPPDIR = /usr/lib/perl5/5.00503/ExtUtils -XSUBPP = $(XSUBPPDIR)/xsubpp -XSPROTOARG = -XSUBPPDEPS = $(XSUBPPDIR)/typemap typemap -XSUBPPARGS = -typemap $(XSUBPPDIR)/typemap -typemap typemap - - -# --- MakeMaker tools_other section: - -SHELL = /bin/sh -CHMOD = chmod -CP = cp -LD = cc -MV = mv -NOOP = $(SHELL) -c true -RM_F = rm -f -RM_RF = rm -rf -TEST_F = test -f -TOUCH = touch -UMASK_NULL = umask 0 -DEV_NULL = > /dev/null 2>&1 - -# The following is a portable way to say mkdir -p -# To see which directories are created, change the if 0 to if 1 -MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath - -# This helps us to minimize the effect of the .exists files A yet -# better solution would be to have a stable file in the perl -# distribution with a timestamp of zero. But this solution doesn't -# need any changes to the core distribution and works with older perls -EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime - -# Here we warn users that an old packlist file was found somewhere, -# and that they should call some uninstall routine -WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \ --e 'print "WARNING: I have found an old package in\n";' \ --e 'print "\t$$ARGV[0].\n";' \ --e 'print "Please make sure the two installations are not conflicting\n";' - -UNINST=0 -VERBINST=1 - -MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \ --e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');" - -DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \ --e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \ --e 'print "=over 4";' \ --e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \ --e 'print "=back";' - -UNINSTALL = $(PERL) -MExtUtils::Install \ --e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \ --e 'print " packlist above carefully.\n There may be errors. Remove the";' \ --e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"' - - -# --- MakeMaker dist section: - -DISTVNAME = $(DISTNAME)-$(VERSION) -TAR = tar -TARFLAGS = cvf -ZIP = zip -ZIPFLAGS = -r -COMPRESS = gzip -SUFFIX = gz -SHAR = shar -PREOP = @$(NOOP) -POSTOP = @$(NOOP) -TO_UNIX = @$(NOOP) -CI = ci -u -RCS_LABEL = rcs -Nv$(VERSION_SYM): -q -DIST_CP = best -DIST_DEFAULT = tardist - - -# --- MakeMaker macro section: - - -# --- MakeMaker depend section: - - -# --- MakeMaker cflags section: - -CCFLAGS = -Dbool=char -DHAS_BOOL -I/usr/local/include -OPTIMIZE = -O2 -m486 -fno-strength-reduce -PERLTYPE = -LARGE = -SPLIT = - - -# --- MakeMaker const_loadlibs section: - -# Crypt::Blowfish might depend on some other libraries: -# See ExtUtils::Liblist for details -# -LD_RUN_PATH = - - -# --- MakeMaker const_cccmd section: -CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \ - $(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \ - $(XS_DEFINE_VERSION) - -# --- MakeMaker post_constants section: - - -# --- MakeMaker pasthru section: - -PASTHRU = LIB="$(LIB)"\ - LIBPERL_A="$(LIBPERL_A)"\ - LINKTYPE="$(LINKTYPE)"\ - PREFIX="$(PREFIX)"\ - OPTIMIZE="$(OPTIMIZE)" - - -# --- MakeMaker c_o section: - -.c$(OBJ_EXT): - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c - -.C$(OBJ_EXT): - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C - -.cpp$(OBJ_EXT): - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp - -.cxx$(OBJ_EXT): - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx - -.cc$(OBJ_EXT): - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc - - -# --- MakeMaker xs_c section: - -.xs.c: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c - - -# --- MakeMaker xs_o section: - -.xs$(OBJ_EXT): - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c - $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c - - -# --- MakeMaker top_targets section: - -#all :: config $(INST_PM) subdirs linkext manifypods - -all :: pure_all manifypods - @$(NOOP) - -pure_all :: config pm_to_blib subdirs linkext - @$(NOOP) - -subdirs :: $(MYEXTLIB) - @$(NOOP) - -config :: Makefile $(INST_LIBDIR)/.exists - @$(NOOP) - -config :: $(INST_ARCHAUTODIR)/.exists - @$(NOOP) - -config :: $(INST_AUTODIR)/.exists - @$(NOOP) - -config :: Version_check - @$(NOOP) - - -$(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h - @$(MKPATH) $(INST_AUTODIR) - @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists - - -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR) - -$(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h - @$(MKPATH) $(INST_LIBDIR) - @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists - - -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR) - -$(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h - @$(MKPATH) $(INST_ARCHAUTODIR) - @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists - - -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) - -config :: $(INST_MAN3DIR)/.exists - @$(NOOP) - - -$(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h - @$(MKPATH) $(INST_MAN3DIR) - @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists - - -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) - -$(O_FILES): $(H_FILES) - -help: - perldoc ExtUtils::MakeMaker - -Version_check: - @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ - -MExtUtils::MakeMaker=Version_check \ - -e "Version_check('$(MM_VERSION)')" - - -# --- MakeMaker linkext section: - -linkext :: $(LINKTYPE) - @$(NOOP) - - -# --- MakeMaker dlsyms section: - - -# --- MakeMaker dynamic section: - -## $(INST_PM) has been moved to the all: target. -## It remains here for awhile to allow for old usage: "make dynamic" -#dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM) -dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) - @$(NOOP) - - -# --- MakeMaker dynamic_bs section: - -BOOTSTRAP = Blowfish.bs - -# As Mkbootstrap might not write a file (if none is required) -# we use touch to prevent make continually trying to remake it. -# The DynaLoader only reads a non-empty file. -$(BOOTSTRAP): Makefile $(INST_ARCHAUTODIR)/.exists - @echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))" - @$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \ - -MExtUtils::Mkbootstrap \ - -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');" - @$(TOUCH) $(BOOTSTRAP) - $(CHMOD) $(PERM_RW) $@ - -$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists - @rm -rf $(INST_BOOT) - -cp $(BOOTSTRAP) $(INST_BOOT) - $(CHMOD) $(PERM_RW) $@ - - -# --- MakeMaker dynamic_lib section: - -# This section creates the dynamically loadable $(INST_DYNAMIC) -# from $(OBJECT) and possibly $(MYEXTLIB). -ARMAYBE = : -OTHERLDFLAGS = -INST_DYNAMIC_DEP = - -$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP) - LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST) - $(CHMOD) $(PERM_RWX) $@ - - -# --- MakeMaker static section: - -## $(INST_PM) has been moved to the all: target. -## It remains here for awhile to allow for old usage: "make static" -#static :: Makefile $(INST_STATIC) $(INST_PM) -static :: Makefile $(INST_STATIC) - @$(NOOP) - - -# --- MakeMaker static_lib section: - -$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists - $(RM_RF) $@ - $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ - $(CHMOD) $(PERM_RWX) $@ - @echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld - - - -# --- MakeMaker manifypods section: -POD2MAN_EXE = /usr/bin/pod2man -POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \ --e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "Makefile";' \ --e 'print "Manifying $$m{$$_}\n";' \ --e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \ --e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}' - -manifypods : pure_all Blowfish.pm - @$(POD2MAN) \ - Blowfish.pm \ - $(INST_MAN3DIR)/Crypt::Blowfish.$(MAN3EXT) - -# --- MakeMaker processPL section: - - -# --- MakeMaker installbin section: - - -# --- MakeMaker subdirs section: - -# none - -# --- MakeMaker clean section: - -# Delete temporary files but do not touch installed files. We don't delete -# the Makefile here so a later make realclean still has a makefile to use. - -clean :: - -rm -rf Blowfish.c ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp - -mv Makefile Makefile.old $(DEV_NULL) - - -# --- MakeMaker realclean section: - -# Delete temporary files (via clean) and also delete installed files -realclean purge :: clean - rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR) - rm -f $(INST_DYNAMIC) $(INST_BOOT) - rm -f $(INST_STATIC) - rm -f $(INST_LIBDIR)/Blowfish.pm - rm -rf Makefile Makefile.old - - -# --- MakeMaker dist_basics section: - -distclean :: realclean distcheck - -distcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \ - -e fullcheck - -skipcheck : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \ - -e skipcheck - -manifest : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \ - -e mkmanifest - - -# --- MakeMaker dist_core section: - -dist : $(DIST_DEFAULT) - @$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \ - -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";' - -tardist : $(DISTVNAME).tar$(SUFFIX) - -zipdist : $(DISTVNAME).zip - -$(DISTVNAME).tar$(SUFFIX) : distdir - $(PREOP) - $(TO_UNIX) - $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME) - $(RM_RF) $(DISTVNAME) - $(COMPRESS) $(DISTVNAME).tar - $(POSTOP) - -$(DISTVNAME).zip : distdir - $(PREOP) - $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME) - $(RM_RF) $(DISTVNAME) - $(POSTOP) - -uutardist : $(DISTVNAME).tar$(SUFFIX) - uuencode $(DISTVNAME).tar$(SUFFIX) \ - $(DISTVNAME).tar$(SUFFIX) > \ - $(DISTVNAME).tar$(SUFFIX)_uu - -shdist : distdir - $(PREOP) - $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar - $(RM_RF) $(DISTVNAME) - $(POSTOP) - - -# --- MakeMaker dist_dir section: - -distdir : - $(RM_RF) $(DISTVNAME) - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \ - -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');" - - -# --- MakeMaker dist_test section: - -disttest : distdir - cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL - cd $(DISTVNAME) && $(MAKE) - cd $(DISTVNAME) && $(MAKE) test - - -# --- MakeMaker dist_ci section: - -ci : - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \ - -e "@all = keys %{ maniread() };" \ - -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \ - -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");' - - -# --- MakeMaker install section: - -install :: all pure_install doc_install - -install_perl :: all pure_perl_install doc_perl_install - -install_site :: all pure_site_install doc_site_install - -install_ :: install_site - @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site - -pure_install :: pure_$(INSTALLDIRS)_install - -doc_install :: doc_$(INSTALLDIRS)_install - @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod - -pure__install : pure_site_install - @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site - -doc__install : doc_site_install - @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site - -pure_perl_install :: - @$(MOD_INSTALL) \ - read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \ - write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \ - $(INST_LIB) $(INSTALLPRIVLIB) \ - $(INST_ARCHLIB) $(INSTALLARCHLIB) \ - $(INST_BIN) $(INSTALLBIN) \ - $(INST_SCRIPT) $(INSTALLSCRIPT) \ - $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ - $(INST_MAN3DIR) $(INSTALLMAN3DIR) - @$(WARN_IF_OLD_PACKLIST) \ - $(SITEARCHEXP)/auto/$(FULLEXT) - - -pure_site_install :: - @$(MOD_INSTALL) \ - read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \ - write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \ - $(INST_LIB) $(INSTALLSITELIB) \ - $(INST_ARCHLIB) $(INSTALLSITEARCH) \ - $(INST_BIN) $(INSTALLBIN) \ - $(INST_SCRIPT) $(INSTALLSCRIPT) \ - $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ - $(INST_MAN3DIR) $(INSTALLMAN3DIR) - @$(WARN_IF_OLD_PACKLIST) \ - $(PERL_ARCHLIB)/auto/$(FULLEXT) - -doc_perl_install :: - -@$(DOC_INSTALL) \ - "Module" "$(NAME)" \ - "installed into" "$(INSTALLPRIVLIB)" \ - LINKTYPE "$(LINKTYPE)" \ - VERSION "$(VERSION)" \ - EXE_FILES "$(EXE_FILES)" \ - >> $(INSTALLARCHLIB)/perllocal.pod - -doc_site_install :: - -@$(DOC_INSTALL) \ - "Module" "$(NAME)" \ - "installed into" "$(INSTALLSITELIB)" \ - LINKTYPE "$(LINKTYPE)" \ - VERSION "$(VERSION)" \ - EXE_FILES "$(EXE_FILES)" \ - >> $(INSTALLARCHLIB)/perllocal.pod - - -uninstall :: uninstall_from_$(INSTALLDIRS)dirs - -uninstall_from_perldirs :: - @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist - -uninstall_from_sitedirs :: - @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist - - -# --- MakeMaker force section: -# Phony target to force checking subdirectories. -FORCE: - @$(NOOP) - - -# --- MakeMaker perldepend section: - -PERL_HDRS = \ -$(PERL_INC)/EXTERN.h $(PERL_INC)/gv.h $(PERL_INC)/pp.h \ -$(PERL_INC)/INTERN.h $(PERL_INC)/handy.h $(PERL_INC)/proto.h \ -$(PERL_INC)/XSUB.h $(PERL_INC)/hv.h $(PERL_INC)/regcomp.h \ -$(PERL_INC)/av.h $(PERL_INC)/keywords.h $(PERL_INC)/regexp.h \ -$(PERL_INC)/config.h $(PERL_INC)/mg.h $(PERL_INC)/scope.h \ -$(PERL_INC)/cop.h $(PERL_INC)/op.h $(PERL_INC)/sv.h \ -$(PERL_INC)/cv.h $(PERL_INC)/opcode.h $(PERL_INC)/unixish.h \ -$(PERL_INC)/dosish.h $(PERL_INC)/patchlevel.h $(PERL_INC)/util.h \ -$(PERL_INC)/embed.h $(PERL_INC)/perl.h $(PERL_INC)/iperlsys.h \ -$(PERL_INC)/form.h $(PERL_INC)/perly.h - -$(OBJECT) : $(PERL_HDRS) - -Blowfish.c : $(XSUBPPDEPS) - - -# --- MakeMaker makefile section: - -$(OBJECT) : $(FIRST_MAKEFILE) - -# We take a very conservative approach here, but it\'s worth it. -# We move Makefile to Makefile.old here to avoid gnu make looping. -Makefile : Makefile.PL $(CONFIGDEP) - @echo "Makefile out-of-date with respect to $?" - @echo "Cleaning current config before rebuilding Makefile..." - -@$(RM_F) Makefile.old - -@$(MV) Makefile Makefile.old - -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP) - $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL - @echo "==> Your Makefile has been rebuilt. <==" - @echo "==> Please rerun the make command. <==" - false - -# To change behavior to :: would be nice, but would break Tk b9.02 -# so you find such a warning below the dist target. -#Makefile :: $(VERSION_FROM) -# @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)" - - -# --- MakeMaker staticmake section: - -# --- MakeMaker makeaperl section --- -MAP_TARGET = perl -FULLPERL = /usr/bin/perl - -$(MAP_TARGET) :: static $(MAKE_APERL_FILE) - $(MAKE) -f $(MAKE_APERL_FILE) $@ - -$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) - @echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET) - @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \ - Makefile.PL DIR= \ - MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \ - MAKEAPERL=1 NORECURS=1 CCCDLFLAGS= - - -# --- MakeMaker test section: - -TEST_VERBOSE=0 -TEST_TYPE=test_$(LINKTYPE) -TEST_FILE = test.pl -TEST_FILES = -TESTDB_SW = -d - -testdb :: testdb_$(LINKTYPE) - -test :: $(TEST_TYPE) - -test_dynamic :: pure_all - PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) - -testdb_dynamic :: pure_all - PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) - -test_ : test_dynamic - -test_static :: pure_all $(MAP_TARGET) - PERL_DL_NONLAZY=1 ./$(MAP_TARGET) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) - -testdb_static :: pure_all $(MAP_TARGET) - PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE) - - - -# --- MakeMaker ppd section: -# Creates a PPD (Perl Package Description) for a binary distribution. -ppd: - @$(PERL) -e "print qq{<SOFTPKG NAME=\"Crypt-Blowfish\" VERSION=\"2,09,0,0\">\n}. qq{\t<TITLE>Crypt-Blowfish</TITLE>\n}. qq{\t<ABSTRACT></ABSTRACT>\n}. qq{\t<AUTHOR></AUTHOR>\n}. qq{\t<IMPLEMENTATION>\n}. qq{\t\t<OS NAME=\"$(OSNAME)\" />\n}. qq{\t\t<ARCHITECTURE NAME=\"i386-linux\" />\n}. qq{\t\t<CODEBASE HREF=\"\" />\n}. qq{\t</IMPLEMENTATION>\n}. qq{</SOFTPKG>\n}" > Crypt-Blowfish.ppd - -# --- MakeMaker pm_to_blib section: - -pm_to_blib: $(TO_INST_PM) - @$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \ - "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \ - -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')" - @$(TOUCH) $@ - - -# --- MakeMaker selfdocument section: - - -# --- MakeMaker postamble section: - - -# End. diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile.PL b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile.PL deleted file mode 100644 index 6acd3a8..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/Makefile.PL +++ /dev/null @@ -1,13 +0,0 @@ -#! /usr/local/bin/perl - -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile being created. -WriteMakefile( - 'NAME' => 'Crypt::Blowfish', - 'DISTNAME' => 'Crypt-Blowfish', - 'VERSION_FROM' => 'Blowfish.pm', - 'OBJECT' => 'Blowfish.o _blowfish.o', - 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} -); - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/README b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/README deleted file mode 100644 index fdcc1dd..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/README +++ /dev/null @@ -1,173 +0,0 @@ -This is Crypt::Blowfish version 2.09, an XS-based implementation of the -Blowfish cryptography algorithm designed by Bruce Schneier. It's designed -to take full advantage of Crypt::CBC when desired. Blowfish keys may be -up to 448 bits (56 bytes) long. This module builds on nearly every platform -that Perl itself does (see Notes for exceptions). - -Prerequisites -------------- - -For the full test suite to run, Crypt::CBC, version 1.22 or higher -is required (recommended is 1.25 or higher), however this module -is not mandatory for standalone Blowfish use. - -Additionally, the author has Crypt::CBC_R available (email address -below for details) which replaces the default 'RandomIV' -initialization vector string that Crypt::CBC uses with a random -string. (random to the limitations that /dev/urandom and friends are) - -Installing Crypt::Blowfish --------------------------- - -nothing unusual: - - 1. perl Makefile.PL - 2. make - 3. make test - 4. make install - -Notes ------ - -This module has been tested successfully against the following: -Linux 2.0.X (x86) -Linux 2.2.X (x86, PPC, Alpha, m68k) -Linux 2.4.X (x86) -Solaris 2.5.1 and 2.7 (SPARC) -FreeBSD 3.3 and 3.4 (x86), 4.0 (alpha) -HP-UX B.10.20 -DEC OSF 5.0 -AIX spbuild 3 4 -Win32 (NT4/SP5, using VC++5.0/VC++6.0) -OpenVMS (DEC C V6.0-001 / Alpha V7.1-2 with MMK make utility) - -Perl 5.004_01, 5.004_04, 5.005_03, 5.6.0, and 5.6.1 - -Please send other successful OS/platform combinations to: -amused(a)pobox.com . Thanks. - -Patches for MacOS welcomed. - -Being an XS implimentation, Crypt::Blowfish is exceptionally faster -than Blowfish_PP (a pure Perl implimentation). Internal testing -displayed a difference of 400 times faster when doing complete -cipher generation and encryption. Using a cached cipher resulted -in 25 times faster than the pure Perl implimentation. (all machines -idled prior to tests below) - -In the case where this module won't build for you, please try the -Crypt::Blowfish_PP module - the Pure Perl implimentation. - -Thanks to Thomas Kratz for the Win32 fixup and VMS report. - -Performance ------------ - -Typical results on a PII-400 Linux machine: -Under Perl-5.005_03: -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 4 wallclock secs ( 3.92 usr + 0.03 sys = 3.95 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 4 wallclock secs ( 3.96 usr + 0.01 sys = 3.97 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.22 usr + 0.00 sys = 0.22 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 1 wallclock secs ( 0.21 usr + 0.00 sys = 0.21 CPU) - - -Typical results from a 270Mhz UltraSPARC IIi (Ultra5 workstation) -Under Perl-5.005_03 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 5 wallclock secs ( 4.05 usr + 0.11 sys = 4.16 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 4 wallclock secs ( 4.06 usr + 0.12 sys = 4.18 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.60 usr + 0.00 sys = 0.60 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 1 wallclock secs ( 0.63 usr + 0.00 sys = 0.63 CPU) - - -Typical results from a PIII-550 Linux machine: -Under Perl-5.005_03 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 3 wallclock secs ( 2.95 usr + 0.00 sys = 2.95 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 3 wallclock secs ( 2.93 usr + 0.00 sys = 2.93 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.17 usr + 0.00 sys = 0.17 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.16 usr + 0.00 sys = 0.16 CPU) - - -Typical results from AIX machine: -Under Perl-5.004_01 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 13 secs (11.77 usr 0.08 sys = 11.85 cpu) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 19 secs (11.98 usr 0.04 sys = 12.02 cpu) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 2 secs ( 1.11 usr 0.00 sys = 1.11 cpu) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 1 secs ( 1.04 usr 0.00 sys = 1.04 cpu) - - -Typical results for Alpha PCA56 (533Mhz) Linux machine: -Under Perl-5.005_03 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 3 wallclock secs ( 2.68 usr + 0.01 sys = 2.69 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 3 wallclock secs ( 2.71 usr + 0.01 sys = 2.73 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.52 usr + 0.00 sys = 0.52 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 1 wallclock secs ( 0.58 usr + 0.00 sys = 0.58 CPU) - - -Typical results for m68k (33Mhz 68040) Linux machine: -Under Perl-5.005_03 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 104 wallclock secs (97.26 usr + 2.50 sys = 99.76 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 102 wallclock secs (97.37 usr + 1.77 sys = 99.14 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 8 wallclock secs ( 7.20 usr + 0.09 sys = 7.29 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 7 wallclock secs ( 7.37 usr + 0.04 sys = 7.41 CPU) - - -Typical results for x86/PPro (dual 200Mhz PPro) Windows machine: -Under Perl-5.005_02 -Running standard mode speed tests.. encrypting with non-cached cipher -5,000 cycles: 8 wallclock secs ( 8.27 usr + 0.00 sys = 8.27 CPU) - -Running standard mode speed tests.. decrypting with non-cached cipher -5,000 cycles: 9 wallclock secs ( 8.25 usr + 0.00 sys = 8.25 CPU) - -Running standard mode speed tests.. encrypting with cached cipher -10,000 cycles: 0 wallclock secs ( 0.69 usr + 0.00 sys = 0.69 CPU) - -Running standard mode speed tests.. decrypting with cached cipher -10,000 cycles: 1 wallclock secs ( 0.69 usr + 0.00 sys = 0.69 CPU) - - - -Dave Paris - W3Works, LLC -<amused(a)pobox.com> diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/_blowfish.c b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/_blowfish.c deleted file mode 100644 index 6ceb4cb..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/_blowfish.c +++ /dev/null @@ -1,478 +0,0 @@ - -/* - * blowfish.c : Source code for the Blowfish block cipher - * - * Part of the Python Cryptography Toolkit, version 1.0.0 - * - * Copyright (C) 1995, A.M. Kuchling - * - * Distribute and use freely; there are no restrictions on further - * dissemination and usage except those imposed by the laws of your - * country of residence. - * - */ - -/*************************************************************************/ -/* File: bf.c - Blowfish cipher by Bruce Schneier, - Code by Bryan Olson, based partly on Schneier's. -*/ - - -/* Define IntU32 to be an unsigned in 32 bits long */ -typedef unsigned int IntU32 ; -typedef unsigned char IntU8 ; -#define NROUNDS 16 - - - -/* Define IntP to be an integer which - is the same size as a pointer. */ -typedef unsigned long IntP ; - - -typedef struct -{ - IntU32 p[2][NROUNDS+2], - sbox[4][256] ; -} BFkey_type ; - -/* File bfinit.h - Data to initialize P and S in BlowFish. -*/ - -static IntU32 p_init[NROUNDS+2] = -{ - 608135816UL, 2242054355UL, 320440878UL, 57701188UL, - 2752067618UL, 698298832UL, 137296536UL, 3964562569UL, - 1160258022UL, 953160567UL, 3193202383UL, 887688300UL, - 3232508343UL, 3380367581UL, 1065670069UL, 3041331479UL, - 2450970073UL, 2306472731UL -} ; - -static IntU32 s_init[4][256] = { - {3509652390UL, 2564797868UL, 805139163UL, 3491422135UL, - 3101798381UL, 1780907670UL, 3128725573UL, 4046225305UL, - 614570311UL, 3012652279UL, 134345442UL, 2240740374UL, - 1667834072UL, 1901547113UL, 2757295779UL, 4103290238UL, - 227898511UL, 1921955416UL, 1904987480UL, 2182433518UL, - 2069144605UL, 3260701109UL, 2620446009UL, 720527379UL, - 3318853667UL, 677414384UL, 3393288472UL, 3101374703UL, - 2390351024UL, 1614419982UL, 1822297739UL, 2954791486UL, - 3608508353UL, 3174124327UL, 2024746970UL, 1432378464UL, - 3864339955UL, 2857741204UL, 1464375394UL, 1676153920UL, - 1439316330UL, 715854006UL, 3033291828UL, 289532110UL, - 2706671279UL, 2087905683UL, 3018724369UL, 1668267050UL, - 732546397UL, 1947742710UL, 3462151702UL, 2609353502UL, - 2950085171UL, 1814351708UL, 2050118529UL, 680887927UL, - 999245976UL, 1800124847UL, 3300911131UL, 1713906067UL, - 1641548236UL, 4213287313UL, 1216130144UL, 1575780402UL, - 4018429277UL, 3917837745UL, 3693486850UL, 3949271944UL, - 596196993UL, 3549867205UL, 258830323UL, 2213823033UL, - 772490370UL, 2760122372UL, 1774776394UL, 2652871518UL, - 566650946UL, 4142492826UL, 1728879713UL, 2882767088UL, - 1783734482UL, 3629395816UL, 2517608232UL, 2874225571UL, - 1861159788UL, 326777828UL, 3124490320UL, 2130389656UL, - 2716951837UL, 967770486UL, 1724537150UL, 2185432712UL, - 2364442137UL, 1164943284UL, 2105845187UL, 998989502UL, - 3765401048UL, 2244026483UL, 1075463327UL, 1455516326UL, - 1322494562UL, 910128902UL, 469688178UL, 1117454909UL, - 936433444UL, 3490320968UL, 3675253459UL, 1240580251UL, - 122909385UL, 2157517691UL, 634681816UL, 4142456567UL, - 3825094682UL, 3061402683UL, 2540495037UL, 79693498UL, - 3249098678UL, 1084186820UL, 1583128258UL, 426386531UL, - 1761308591UL, 1047286709UL, 322548459UL, 995290223UL, - 1845252383UL, 2603652396UL, 3431023940UL, 2942221577UL, - 3202600964UL, 3727903485UL, 1712269319UL, 422464435UL, - 3234572375UL, 1170764815UL, 3523960633UL, 3117677531UL, - 1434042557UL, 442511882UL, 3600875718UL, 1076654713UL, - 1738483198UL, 4213154764UL, 2393238008UL, 3677496056UL, - 1014306527UL, 4251020053UL, 793779912UL, 2902807211UL, - 842905082UL, 4246964064UL, 1395751752UL, 1040244610UL, - 2656851899UL, 3396308128UL, 445077038UL, 3742853595UL, - 3577915638UL, 679411651UL, 2892444358UL, 2354009459UL, - 1767581616UL, 3150600392UL, 3791627101UL, 3102740896UL, - 284835224UL, 4246832056UL, 1258075500UL, 768725851UL, - 2589189241UL, 3069724005UL, 3532540348UL, 1274779536UL, - 3789419226UL, 2764799539UL, 1660621633UL, 3471099624UL, - 4011903706UL, 913787905UL, 3497959166UL, 737222580UL, - 2514213453UL, 2928710040UL, 3937242737UL, 1804850592UL, - 3499020752UL, 2949064160UL, 2386320175UL, 2390070455UL, - 2415321851UL, 4061277028UL, 2290661394UL, 2416832540UL, - 1336762016UL, 1754252060UL, 3520065937UL, 3014181293UL, - 791618072UL, 3188594551UL, 3933548030UL, 2332172193UL, - 3852520463UL, 3043980520UL, 413987798UL, 3465142937UL, - 3030929376UL, 4245938359UL, 2093235073UL, 3534596313UL, - 375366246UL, 2157278981UL, 2479649556UL, 555357303UL, - 3870105701UL, 2008414854UL, 3344188149UL, 4221384143UL, - 3956125452UL, 2067696032UL, 3594591187UL, 2921233993UL, - 2428461UL, 544322398UL, 577241275UL, 1471733935UL, - 610547355UL, 4027169054UL, 1432588573UL, 1507829418UL, - 2025931657UL, 3646575487UL, 545086370UL, 48609733UL, - 2200306550UL, 1653985193UL, 298326376UL, 1316178497UL, - 3007786442UL, 2064951626UL, 458293330UL, 2589141269UL, - 3591329599UL, 3164325604UL, 727753846UL, 2179363840UL, - 146436021UL, 1461446943UL, 4069977195UL, 705550613UL, - 3059967265UL, 3887724982UL, 4281599278UL, 3313849956UL, - 1404054877UL, 2845806497UL, 146425753UL, 1854211946UL}, - -{ 1266315497UL, 3048417604UL, 3681880366UL, 3289982499UL, - 2909710000UL, 1235738493UL, 2632868024UL, 2414719590UL, - 3970600049UL, 1771706367UL, 1449415276UL, 3266420449UL, - 422970021UL, 1963543593UL, 2690192192UL, 3826793022UL, - 1062508698UL, 1531092325UL, 1804592342UL, 2583117782UL, - 2714934279UL, 4024971509UL, 1294809318UL, 4028980673UL, - 1289560198UL, 2221992742UL, 1669523910UL, 35572830UL, - 157838143UL, 1052438473UL, 1016535060UL, 1802137761UL, - 1753167236UL, 1386275462UL, 3080475397UL, 2857371447UL, - 1040679964UL, 2145300060UL, 2390574316UL, 1461121720UL, - 2956646967UL, 4031777805UL, 4028374788UL, 33600511UL, - 2920084762UL, 1018524850UL, 629373528UL, 3691585981UL, - 3515945977UL, 2091462646UL, 2486323059UL, 586499841UL, - 988145025UL, 935516892UL, 3367335476UL, 2599673255UL, - 2839830854UL, 265290510UL, 3972581182UL, 2759138881UL, - 3795373465UL, 1005194799UL, 847297441UL, 406762289UL, - 1314163512UL, 1332590856UL, 1866599683UL, 4127851711UL, - 750260880UL, 613907577UL, 1450815602UL, 3165620655UL, - 3734664991UL, 3650291728UL, 3012275730UL, 3704569646UL, - 1427272223UL, 778793252UL, 1343938022UL, 2676280711UL, - 2052605720UL, 1946737175UL, 3164576444UL, 3914038668UL, - 3967478842UL, 3682934266UL, 1661551462UL, 3294938066UL, - 4011595847UL, 840292616UL, 3712170807UL, 616741398UL, - 312560963UL, 711312465UL, 1351876610UL, 322626781UL, - 1910503582UL, 271666773UL, 2175563734UL, 1594956187UL, - 70604529UL, 3617834859UL, 1007753275UL, 1495573769UL, - 4069517037UL, 2549218298UL, 2663038764UL, 504708206UL, - 2263041392UL, 3941167025UL, 2249088522UL, 1514023603UL, - 1998579484UL, 1312622330UL, 694541497UL, 2582060303UL, - 2151582166UL, 1382467621UL, 776784248UL, 2618340202UL, - 3323268794UL, 2497899128UL, 2784771155UL, 503983604UL, - 4076293799UL, 907881277UL, 423175695UL, 432175456UL, - 1378068232UL, 4145222326UL, 3954048622UL, 3938656102UL, - 3820766613UL, 2793130115UL, 2977904593UL, 26017576UL, - 3274890735UL, 3194772133UL, 1700274565UL, 1756076034UL, - 4006520079UL, 3677328699UL, 720338349UL, 1533947780UL, - 354530856UL, 688349552UL, 3973924725UL, 1637815568UL, - 332179504UL, 3949051286UL, 53804574UL, 2852348879UL, - 3044236432UL, 1282449977UL, 3583942155UL, 3416972820UL, - 4006381244UL, 1617046695UL, 2628476075UL, 3002303598UL, - 1686838959UL, 431878346UL, 2686675385UL, 1700445008UL, - 1080580658UL, 1009431731UL, 832498133UL, 3223435511UL, - 2605976345UL, 2271191193UL, 2516031870UL, 1648197032UL, - 4164389018UL, 2548247927UL, 300782431UL, 375919233UL, - 238389289UL, 3353747414UL, 2531188641UL, 2019080857UL, - 1475708069UL, 455242339UL, 2609103871UL, 448939670UL, - 3451063019UL, 1395535956UL, 2413381860UL, 1841049896UL, - 1491858159UL, 885456874UL, 4264095073UL, 4001119347UL, - 1565136089UL, 3898914787UL, 1108368660UL, 540939232UL, - 1173283510UL, 2745871338UL, 3681308437UL, 4207628240UL, - 3343053890UL, 4016749493UL, 1699691293UL, 1103962373UL, - 3625875870UL, 2256883143UL, 3830138730UL, 1031889488UL, - 3479347698UL, 1535977030UL, 4236805024UL, 3251091107UL, - 2132092099UL, 1774941330UL, 1199868427UL, 1452454533UL, - 157007616UL, 2904115357UL, 342012276UL, 595725824UL, - 1480756522UL, 206960106UL, 497939518UL, 591360097UL, - 863170706UL, 2375253569UL, 3596610801UL, 1814182875UL, - 2094937945UL, 3421402208UL, 1082520231UL, 3463918190UL, - 2785509508UL, 435703966UL, 3908032597UL, 1641649973UL, - 2842273706UL, 3305899714UL, 1510255612UL, 2148256476UL, - 2655287854UL, 3276092548UL, 4258621189UL, 236887753UL, - 3681803219UL, 274041037UL, 1734335097UL, 3815195456UL, - 3317970021UL, 1899903192UL, 1026095262UL, 4050517792UL, - 356393447UL, 2410691914UL, 3873677099UL, 3682840055UL}, - -{ 3913112168UL, 2491498743UL, 4132185628UL, 2489919796UL, - 1091903735UL, 1979897079UL, 3170134830UL, 3567386728UL, - 3557303409UL, 857797738UL, 1136121015UL, 1342202287UL, - 507115054UL, 2535736646UL, 337727348UL, 3213592640UL, - 1301675037UL, 2528481711UL, 1895095763UL, 1721773893UL, - 3216771564UL, 62756741UL, 2142006736UL, 835421444UL, - 2531993523UL, 1442658625UL, 3659876326UL, 2882144922UL, - 676362277UL, 1392781812UL, 170690266UL, 3921047035UL, - 1759253602UL, 3611846912UL, 1745797284UL, 664899054UL, - 1329594018UL, 3901205900UL, 3045908486UL, 2062866102UL, - 2865634940UL, 3543621612UL, 3464012697UL, 1080764994UL, - 553557557UL, 3656615353UL, 3996768171UL, 991055499UL, - 499776247UL, 1265440854UL, 648242737UL, 3940784050UL, - 980351604UL, 3713745714UL, 1749149687UL, 3396870395UL, - 4211799374UL, 3640570775UL, 1161844396UL, 3125318951UL, - 1431517754UL, 545492359UL, 4268468663UL, 3499529547UL, - 1437099964UL, 2702547544UL, 3433638243UL, 2581715763UL, - 2787789398UL, 1060185593UL, 1593081372UL, 2418618748UL, - 4260947970UL, 69676912UL, 2159744348UL, 86519011UL, - 2512459080UL, 3838209314UL, 1220612927UL, 3339683548UL, - 133810670UL, 1090789135UL, 1078426020UL, 1569222167UL, - 845107691UL, 3583754449UL, 4072456591UL, 1091646820UL, - 628848692UL, 1613405280UL, 3757631651UL, 526609435UL, - 236106946UL, 48312990UL, 2942717905UL, 3402727701UL, - 1797494240UL, 859738849UL, 992217954UL, 4005476642UL, - 2243076622UL, 3870952857UL, 3732016268UL, 765654824UL, - 3490871365UL, 2511836413UL, 1685915746UL, 3888969200UL, - 1414112111UL, 2273134842UL, 3281911079UL, 4080962846UL, - 172450625UL, 2569994100UL, 980381355UL, 4109958455UL, - 2819808352UL, 2716589560UL, 2568741196UL, 3681446669UL, - 3329971472UL, 1835478071UL, 660984891UL, 3704678404UL, - 4045999559UL, 3422617507UL, 3040415634UL, 1762651403UL, - 1719377915UL, 3470491036UL, 2693910283UL, 3642056355UL, - 3138596744UL, 1364962596UL, 2073328063UL, 1983633131UL, - 926494387UL, 3423689081UL, 2150032023UL, 4096667949UL, - 1749200295UL, 3328846651UL, 309677260UL, 2016342300UL, - 1779581495UL, 3079819751UL, 111262694UL, 1274766160UL, - 443224088UL, 298511866UL, 1025883608UL, 3806446537UL, - 1145181785UL, 168956806UL, 3641502830UL, 3584813610UL, - 1689216846UL, 3666258015UL, 3200248200UL, 1692713982UL, - 2646376535UL, 4042768518UL, 1618508792UL, 1610833997UL, - 3523052358UL, 4130873264UL, 2001055236UL, 3610705100UL, - 2202168115UL, 4028541809UL, 2961195399UL, 1006657119UL, - 2006996926UL, 3186142756UL, 1430667929UL, 3210227297UL, - 1314452623UL, 4074634658UL, 4101304120UL, 2273951170UL, - 1399257539UL, 3367210612UL, 3027628629UL, 1190975929UL, - 2062231137UL, 2333990788UL, 2221543033UL, 2438960610UL, - 1181637006UL, 548689776UL, 2362791313UL, 3372408396UL, - 3104550113UL, 3145860560UL, 296247880UL, 1970579870UL, - 3078560182UL, 3769228297UL, 1714227617UL, 3291629107UL, - 3898220290UL, 166772364UL, 1251581989UL, 493813264UL, - 448347421UL, 195405023UL, 2709975567UL, 677966185UL, - 3703036547UL, 1463355134UL, 2715995803UL, 1338867538UL, - 1343315457UL, 2802222074UL, 2684532164UL, 233230375UL, - 2599980071UL, 2000651841UL, 3277868038UL, 1638401717UL, - 4028070440UL, 3237316320UL, 6314154UL, 819756386UL, - 300326615UL, 590932579UL, 1405279636UL, 3267499572UL, - 3150704214UL, 2428286686UL, 3959192993UL, 3461946742UL, - 1862657033UL, 1266418056UL, 963775037UL, 2089974820UL, - 2263052895UL, 1917689273UL, 448879540UL, 3550394620UL, - 3981727096UL, 150775221UL, 3627908307UL, 1303187396UL, - 508620638UL, 2975983352UL, 2726630617UL, 1817252668UL, - 1876281319UL, 1457606340UL, 908771278UL, 3720792119UL, - 3617206836UL, 2455994898UL, 1729034894UL, 1080033504UL}, - -{ 976866871UL, 3556439503UL, 2881648439UL, 1522871579UL, - 1555064734UL, 1336096578UL, 3548522304UL, 2579274686UL, - 3574697629UL, 3205460757UL, 3593280638UL, 3338716283UL, - 3079412587UL, 564236357UL, 2993598910UL, 1781952180UL, - 1464380207UL, 3163844217UL, 3332601554UL, 1699332808UL, - 1393555694UL, 1183702653UL, 3581086237UL, 1288719814UL, - 691649499UL, 2847557200UL, 2895455976UL, 3193889540UL, - 2717570544UL, 1781354906UL, 1676643554UL, 2592534050UL, - 3230253752UL, 1126444790UL, 2770207658UL, 2633158820UL, - 2210423226UL, 2615765581UL, 2414155088UL, 3127139286UL, - 673620729UL, 2805611233UL, 1269405062UL, 4015350505UL, - 3341807571UL, 4149409754UL, 1057255273UL, 2012875353UL, - 2162469141UL, 2276492801UL, 2601117357UL, 993977747UL, - 3918593370UL, 2654263191UL, 753973209UL, 36408145UL, - 2530585658UL, 25011837UL, 3520020182UL, 2088578344UL, - 530523599UL, 2918365339UL, 1524020338UL, 1518925132UL, - 3760827505UL, 3759777254UL, 1202760957UL, 3985898139UL, - 3906192525UL, 674977740UL, 4174734889UL, 2031300136UL, - 2019492241UL, 3983892565UL, 4153806404UL, 3822280332UL, - 352677332UL, 2297720250UL, 60907813UL, 90501309UL, - 3286998549UL, 1016092578UL, 2535922412UL, 2839152426UL, - 457141659UL, 509813237UL, 4120667899UL, 652014361UL, - 1966332200UL, 2975202805UL, 55981186UL, 2327461051UL, - 676427537UL, 3255491064UL, 2882294119UL, 3433927263UL, - 1307055953UL, 942726286UL, 933058658UL, 2468411793UL, - 3933900994UL, 4215176142UL, 1361170020UL, 2001714738UL, - 2830558078UL, 3274259782UL, 1222529897UL, 1679025792UL, - 2729314320UL, 3714953764UL, 1770335741UL, 151462246UL, - 3013232138UL, 1682292957UL, 1483529935UL, 471910574UL, - 1539241949UL, 458788160UL, 3436315007UL, 1807016891UL, - 3718408830UL, 978976581UL, 1043663428UL, 3165965781UL, - 1927990952UL, 4200891579UL, 2372276910UL, 3208408903UL, - 3533431907UL, 1412390302UL, 2931980059UL, 4132332400UL, - 1947078029UL, 3881505623UL, 4168226417UL, 2941484381UL, - 1077988104UL, 1320477388UL, 886195818UL, 18198404UL, - 3786409000UL, 2509781533UL, 112762804UL, 3463356488UL, - 1866414978UL, 891333506UL, 18488651UL, 661792760UL, - 1628790961UL, 3885187036UL, 3141171499UL, 876946877UL, - 2693282273UL, 1372485963UL, 791857591UL, 2686433993UL, - 3759982718UL, 3167212022UL, 3472953795UL, 2716379847UL, - 445679433UL, 3561995674UL, 3504004811UL, 3574258232UL, - 54117162UL, 3331405415UL, 2381918588UL, 3769707343UL, - 4154350007UL, 1140177722UL, 4074052095UL, 668550556UL, - 3214352940UL, 367459370UL, 261225585UL, 2610173221UL, - 4209349473UL, 3468074219UL, 3265815641UL, 314222801UL, - 3066103646UL, 3808782860UL, 282218597UL, 3406013506UL, - 3773591054UL, 379116347UL, 1285071038UL, 846784868UL, - 2669647154UL, 3771962079UL, 3550491691UL, 2305946142UL, - 453669953UL, 1268987020UL, 3317592352UL, 3279303384UL, - 3744833421UL, 2610507566UL, 3859509063UL, 266596637UL, - 3847019092UL, 517658769UL, 3462560207UL, 3443424879UL, - 370717030UL, 4247526661UL, 2224018117UL, 4143653529UL, - 4112773975UL, 2788324899UL, 2477274417UL, 1456262402UL, - 2901442914UL, 1517677493UL, 1846949527UL, 2295493580UL, - 3734397586UL, 2176403920UL, 1280348187UL, 1908823572UL, - 3871786941UL, 846861322UL, 1172426758UL, 3287448474UL, - 3383383037UL, 1655181056UL, 3139813346UL, 901632758UL, - 1897031941UL, 2986607138UL, 3066810236UL, 3447102507UL, - 1393639104UL, 373351379UL, 950779232UL, 625454576UL, - 3124240540UL, 4148612726UL, 2007998917UL, 544563296UL, - 2244738638UL, 2330496472UL, 2058025392UL, 1291430526UL, - 424198748UL, 50039436UL, 29584100UL, 3605783033UL, - 2429876329UL, 2791104160UL, 1057563949UL, 3255363231UL, - 3075367218UL, 3463963227UL, 1469046755UL, 985887462UL} -} ; - -/* sLb(s,n) allows us to subsript s by byte offsets, which - allows us to avoid a subscript scaling. -*/ -#define sub(s,n) *((IntU32 *)((IntP)s+(n))) - -/* Below is one BlowFish round including the F function -*/ -#define round(l,r,n) \ - l ^= P[n]; \ - r ^= ( (sub(S[0],l>>22 & 0x3fc) + sub(S[1],l>>14 & 0x3fc)) \ - ^ sub(S[2],l>>6 & 0x3fc) ) +S[3][l & 0xff] - - - -/* This function requires the block to be two 32 bit integers, in -whatever endian form the machine uses. On little endian machines -use crypt_8bytes() on user data. make_bfkey should call crypt_block -on either endian machine. Pass direction 0 to encrypt, 1 to decrypt. -*/ -static void crypt_block(block, bfkey, direction) - IntU32 block[2]; - BFkey_type *bfkey; - short direction; -{ - register IntU32 left, right, - (*S)[256], - *P ; - - left = block[0] ; right = block[1] ; - - S = bfkey->sbox ; - P = bfkey->p[direction] ; - - round( left, right, 0 ) ; round( right, left, 1 ) ; - round( left, right, 2 ) ; round( right, left, 3 ) ; - round( left, right, 4 ) ; round( right, left, 5 ) ; - round( left, right, 6 ) ; round( right, left, 7 ) ; - round( left, right, 8 ) ; round( right, left, 9 ) ; - round( left, right, 10 ) ; round( right, left, 11 ) ; - round( left, right, 12 ) ; round( right, left, 13 ) ; - round( left, right, 14 ) ; round( right, left, 15 ) ; - - left = left ^ P[NROUNDS] ; - right = right ^ P[NROUNDS+1] ; - block[0] = right ; - block[1] = left ; -} - -/* The following should be allignment and endian independent. - I have not tested it on a little-endian machine. - It takes the input block from source, and puts the output - in dest. They can be the same. It takes the same direction - parameter as crypt_block(). -*/ -void -blowfish_crypt_8bytes(source, dest, bfkey, direction) - IntU8 *source, *dest; - BFkey_type *bfkey; - short direction; -{ - IntU32 block[2] ; - - block[0] = source[3] | source[2]<<8 | source[1]<<16 | source[0]<<24 ; - block[1] = source[7] | source[6]<<8 | source[5]<<16 | source[4]<<24 ; - - crypt_block( block, bfkey, direction ) ; - - dest[0]= block[0]>>24 ; - dest[1]= block[0]>>16 & 0xff ; - dest[2]= block[0]>>8 & 0xff ; - dest[3]= block[0] & 0xff ; - dest[4]= block[1]>>24 ; - dest[5]= block[1]>>16 & 0xff ; - dest[6]= block[1]>> 8 & 0xff ; - dest[7]= block[1] & 0xff ; -} - -/* make_bfkey() takes the address of the key data as a char*, - and the length of the key in bytes. It generates and returns - a pointer to an object of BFkey_type, which can be passed - to the crypt functions. It does some simple testing of the - init data and crypt routine, and returns 0 on error. -*/ -int -blowfish_make_bfkey(key_string, keylength, bfkey) - unsigned char *key_string; - int keylength; - BFkey_type *bfkey; -{ - int i, j, k ; - IntU32 dspace[2], - checksum=0 ; - - /* Copy constant initial data to P vector */ - for( i=0 ; i<NROUNDS+2 ; ++i ) - { - bfkey->p[0][i] = p_init[i] ; - bfkey->p[1][NROUNDS+1-i] = p_init[i] ; - checksum = (checksum<<1 | checksum>>31)+p_init[i] ; - } - - /* Copy constant initial data to sboxes */ - for( i=0 ; i<4 ; ++i ) - for( j=0 ; j<256 ; ++j ) - { - bfkey->sbox[i][j] = s_init[i][j] ; - checksum = ((checksum*13)<<11 | (checksum*13)>>21) - + s_init[i][j] ; - } - - /* Test init data. */ - if( checksum != 0x55861a61 ) - { - strcpy((char *)bfkey, "Bad initialization data"); - return -1; - } - - dspace[0] = 0 ; - dspace[1] = 0 ; - - /* Test the crypt_block() routine. */ - for( i=0 ; i<10 ; ++i ) - crypt_block( dspace, bfkey, 0 ) ; - checksum = dspace[0] ; - for( i=0 ; i<10 ; ++i ) - crypt_block( dspace, bfkey, 1 ) ; - if( (checksum!=0xaafe4ebd) || dspace[0] || dspace[1] ) - { - strcpy((char *)bfkey, "Error in crypt_block routine"); - return -1; - } - - - /* Xor key string into encryption key vector */ - j = 0 ; - for (i=0 ; i<NROUNDS+2 ; ++i) - { - IntU32 data; - data = 0 ; - for (k=0 ; k<4 ; ++k ) - data = (data << 8) | key_string[j++ % keylength]; - (bfkey->p)[0][i] ^= data; - } - - - for (i = 0 ; i<NROUNDS+2 ; i+=2) - { - crypt_block( dspace, bfkey, 0 ) ; - bfkey->p[0][i] = dspace[0] ; - bfkey->p[1][NROUNDS+1-i] = dspace[0] ; - bfkey->p[0][i+1] = dspace[1] ; - bfkey->p[1][NROUNDS-i] = dspace[1] ; - } - - for ( i=0 ; i<4 ; ++i ) - for ( j=0 ; j<256 ; j+=2 ) - { - crypt_block( dspace, bfkey, 0 ) ; - bfkey->sbox[i][j] = dspace[0] ; - bfkey->sbox[i][j+1] = dspace[1] ; - } - - return 0; -} diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/arch/auto/Crypt/Blowfish/.exists b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/arch/auto/Crypt/Blowfish/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/arch/auto/Crypt/Blowfish/Blowfish.bs b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/arch/auto/Crypt/Blowfish/Blowfish.bs deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/.exists b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/Blowfish.pm b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/Blowfish.pm deleted file mode 100644 index 9295a5a..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/Crypt/Blowfish.pm +++ /dev/null @@ -1,207 +0,0 @@ -package Crypt::Blowfish; - -require Exporter; -require DynaLoader; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); - -@ISA = qw(Exporter DynaLoader); -# @ISA = qw(Exporter DynaLoader Crypt::BlockCipher); - -# Items to export into callers namespace by default -@EXPORT = qw(); - -# Other items we are prepared to export if requested -@EXPORT_OK = qw( - blocksize keysize min_keysize max_keysize - new encrypt decrypt -); - -$VERSION = '2.09'; -bootstrap Crypt::Blowfish $VERSION; - -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - - -sub blocksize { 8; } # /* byte my shiny metal.. */ -sub keysize { 0; } # /* we'll leave this at 8 .. for now. expect change. */ -sub min_keysize { 8; } -sub max_keysize { 56; } - -sub new -{ - usage("new Blowfish key") unless @_ == 2; - - my $type = shift; my $self = {}; bless $self, $type; - - $self->{'ks'} = Crypt::Blowfish::init(shift); - - $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 0); - - $data; -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 1); - - $data; -} - -1; - -__END__ -# -# Parts Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -# New Parts Copyright (C) 2000, 2001 W3Works, LLC (http://www.w3works.com/) -# All rights reserved. -# - -=head1 NAME - -Crypt::Blowfish - Perl Blowfish encryption module - -=head1 SYNOPSIS - - use Crypt::Blowfish; - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - my $plaintext = $cipher->decrypt($ciphertext); - -=head1 DESCRIPTION - -Blowfish is capable of strong encryption and can use key sizes up -to 56 bytes (a 448 bit key). You're encouraged to take advantage -of the full key size to ensure the strongest encryption possible -from this module. - -Crypt::Blowfish has the following methods: - -=over 4 - - blocksize() - keysize() - encrypt() - decrypt() - -=back - -=head1 FUNCTIONS - -=over 4 - -=item blocksize - -Returns the size (in bytes) of the block cipher. - -Crypt::Blowfish doesn't return a key size due to its ability -to use variable-length keys. (well, more accurately, it won't -as of 2.09 .. for now, it does. expect that to change) - -=item new - - my $cipher = new Crypt::Blowfish $key; - -This creates a new Crypt::Blowfish BlockCipher object, using $key, -where $key is a key of C<keysize()> bytes (minimum of eight bytes). - -=item encrypt - - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt($plaintext); - -This function encrypts $plaintext and returns the $ciphertext -where $plaintext and $ciphertext must be of C<blocksize()> bytes. -(hint: Blowfish is an 8 byte block cipher) - -=item decrypt - - my $cipher = new Crypt::Blowfish $key; - my $plaintext = $cipher->decrypt($ciphertext); - -This function decrypts $ciphertext and returns the $plaintext -where $plaintext and $ciphertext must be of C<blocksize()> bytes. -(hint: see previous hint) - -=back - -=head1 EXAMPLE - - my $key = pack("H16", "0123456789ABCDEF"); # min. 8 bytes - my $cipher = new Crypt::Blowfish $key; - my $ciphertext = $cipher->encrypt("plaintex"); # SEE NOTES - print unpack("H16", $ciphertext), "\n"; - -=head1 PLATFORMS - - Please see the README document for platforms and performance - tests. - -=head1 NOTES - -The module is capable of being used with Crypt::CBC. You're -encouraged to read the perldoc for Crypt::CBC if you intend to -use this module for Cipher Block Chaining modes. In fact, if -you have any intentions of encrypting more than eight bytes of -data with this, or any other block cipher, you're going to need -B<some> type of block chaining help. Crypt::CBC tends to be -very good at this. If you're not going to encrypt more than -eight bytes, your data B<must> be B<exactly> eight bytes long. -If need be, do your own padding. "\0" as a null byte is perfectly -valid to use for this. Additionally, the current maintainer for -Crypt::Blowfish may or may not release Crypt::CBC_R which -replaces the default 'RandomIV' initialization vector in -Crypt::CBC with a random initialization vector. (to the limits -of /dev/urandom and associates) In either case, please email -amused(a)pobox.com for Crypt::CBC_R. - -=head1 SEE ALSO - -Crypt::CBC, -Crypt::DES, -Crypt::IDEA - -Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, -published by John Wiley & Sons, Inc. - -=head1 COPYRIGHT - -The implementation of the Blowfish algorithm was developed by, -and is copyright of, A.M. Kuchling. - -Other parts of the perl extension and module are -copyright of Systemics Ltd ( http://www.systemics.com/ ). - -Code revisions, updates, and standalone release are copyright -1999-2001 W3Works, LLC. - -=head1 AUTHOR - -Original algorithm, Bruce Shneier. Original implementation, A.M. -Kuchling. Original Perl implementation, Systemics Ltd. Current -maintenance by W3Works, LLC. - -Current revision and maintainer: Dave Paris <amused(a)pobox.com> - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/auto/Crypt/Blowfish/.exists b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/lib/auto/Crypt/Blowfish/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/.exists b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/.exists deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/Crypt::Blowfish.3 b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/Crypt::Blowfish.3 deleted file mode 100644 index 84ca903..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blib/man3/Crypt::Blowfish.3 +++ /dev/null @@ -1,330 +0,0 @@ -.rn '' }` -''' $RCSfile: Crypt::Blowfish.3,v $$Revision: 1.1.1.1 $$Date: 2002-03-08 21:12:33 $ -''' -''' $Log: not supported by cvs2svn $ -''' -.de Sh -.br -.if t .Sp -.ne 5 -.PP -\fB\\$1\fR -.PP -.. -.de Sp -.if t .sp .5v -.if n .sp -.. -.de Ip -.br -.ie \\n(.$>=3 .ne \\$3 -.el .ne 3 -.IP "\\$1" \\$2 -.. -.de Vb -.ft CW -.nf -.ne \\$1 -.. -.de Ve -.ft R - -.fi -.. -''' -''' -''' Set up \*(-- to give an unbreakable dash; -''' string Tr holds user defined translation string. -''' Bell System Logo is used as a dummy character. -''' -.tr \(*W-|\(bv\*(Tr -.ie n \{\ -.ds -- \(*W- -.ds PI pi -.if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch -.if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch -.ds L" "" -.ds R" "" -''' \*(M", \*(S", \*(N" and \*(T" are the equivalent of -''' \*(L" and \*(R", except that they are used on ".xx" lines, -''' such as .IP and .SH, which do another additional levels of -''' double-quote interpretation -.ds M" """ -.ds S" """ -.ds N" """"" -.ds T" """"" -.ds L' ' -.ds R' ' -.ds M' ' -.ds S' ' -.ds N' ' -.ds T' ' -'br\} -.el\{\ -.ds -- \(em\| -.tr \*(Tr -.ds L" `` -.ds R" '' -.ds M" `` -.ds S" '' -.ds N" `` -.ds T" '' -.ds L' ` -.ds R' ' -.ds M' ` -.ds S' ' -.ds N' ` -.ds T' ' -.ds PI \(*p -'br\} -.\" If the F register is turned on, we'll generate -.\" index entries out stderr for the following things: -.\" TH Title -.\" SH Header -.\" Sh Subsection -.\" Ip Item -.\" X<> Xref (embedded -.\" Of course, you have to process the output yourself -.\" in some meaninful fashion. -.if \nF \{ -.de IX -.tm Index:\\$1\t\\n%\t"\\$2" -.. -.nr % 0 -.rr F -.\} -.TH Blowfish 3 "perl 5.005, patch 03" "12/Nov/2001" "User Contributed Perl Documentation" -.UC -.if n .hy 0 -.if n .na -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.de CQ \" put $1 in typewriter font -.ft CW -'if n "\c -'if t \\&\\$1\c -'if n \\&\\$1\c -'if n \&" -\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 -'.ft R -.. -.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 -. \" AM - accent mark definitions -.bd B 3 -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds ? ? -. ds ! ! -. ds / -. ds q -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' -. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -. ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] -.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' -.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' -.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -.ds oe o\h'-(\w'o'u*4/10)'e -.ds Oe O\h'-(\w'O'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds v \h'-1'\o'\(aa\(ga' -. ds _ \h'-1'^ -. ds . \h'-1'. -. ds 3 3 -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -. ds oe oe -. ds Oe OE -.\} -.rm #[ #] #H #V #F C -.SH "NAME" -Crypt::Blowfish \- Perl Blowfish encryption module -.SH "SYNOPSIS" -.PP -.Vb 4 -\& use Crypt::Blowfish; -\& my $cipher = new Crypt::Blowfish $key; -\& my $ciphertext = $cipher->encrypt($plaintext); -\& my $plaintext = $cipher->decrypt($ciphertext); -.Ve -.SH "DESCRIPTION" -Blowfish is capable of strong encryption and can use key sizes up -to 56 bytes (a 448 bit key). You're encouraged to take advantage -of the full key size to ensure the strongest encryption possible -from this module. -.PP -Crypt::Blowfish has the following methods: -.Sp -.Vb 4 -\& blocksize() -\& keysize() -\& encrypt() -\& decrypt() -.Ve -.SH "FUNCTIONS" -.Ip "blocksize" 4 -Returns the size (in bytes) of the block cipher. -.Sp -Crypt::Blowfish doesn't return a key size due to its ability -to use variable-length keys. (well, more accurately, it won't -as of 2.09 .. for now, it does. expect that to change) -.Ip "new" 4 -.Sp -.Vb 1 -\& my $cipher = new Crypt::Blowfish $key; -.Ve -This creates a new Crypt::Blowfish BlockCipher object, using \f(CW$key\fR, -where \f(CW$key\fR is a key of \f(CWkeysize()\fR bytes (minimum of eight bytes). -.Ip "encrypt" 4 -.Sp -.Vb 2 -\& my $cipher = new Crypt::Blowfish $key; -\& my $ciphertext = $cipher->encrypt($plaintext); -.Ve -This function encrypts \f(CW$plaintext\fR and returns the \f(CW$ciphertext\fR -where \f(CW$plaintext\fR and \f(CW$ciphertext\fR must be of \f(CWblocksize()\fR bytes. -(hint: Blowfish is an 8 byte block cipher) -.Ip "decrypt" 4 -.Sp -.Vb 2 -\& my $cipher = new Crypt::Blowfish $key; -\& my $plaintext = $cipher->decrypt($ciphertext); -.Ve -This function decrypts \f(CW$ciphertext\fR and returns the \f(CW$plaintext\fR -where \f(CW$plaintext\fR and \f(CW$ciphertext\fR must be of \f(CWblocksize()\fR bytes. -(hint: see previous hint) -.SH "EXAMPLE" -.PP -.Vb 4 -\& my $key = pack("H16", "0123456789ABCDEF"); # min. 8 bytes -\& my $cipher = new Crypt::Blowfish $key; -\& my $ciphertext = $cipher->encrypt("plaintex"); # SEE NOTES -\& print unpack("H16", $ciphertext), "\en"; -.Ve -.SH "PLATFORMS" -.PP -.Vb 2 -\& Please see the README document for platforms and performance -\& tests. -.Ve -.SH "NOTES" -The module is capable of being used with Crypt::CBC. You're -encouraged to read the perldoc for Crypt::CBC if you intend to -use this module for Cipher Block Chaining modes. In fact, if -you have any intentions of encrypting more than eight bytes of -data with this, or any other block cipher, you're going to need -\fBsome\fR type of block chaining help. Crypt::CBC tends to be -very good at this. If you're not going to encrypt more than -eight bytes, your data \fBmust\fR be \fBexactly\fR eight bytes long. -If need be, do your own padding. \*(L"\e0\*(R" as a null byte is perfectly -valid to use for this. Additionally, the current maintainer for -Crypt::Blowfish may or may not release Crypt::CBC_R which -replaces the default \*(L'RandomIV\*(R' initialization vector in -Crypt::CBC with a random initialization vector. (to the limits -of /dev/urandom and associates) In either case, please email -amused(a)pobox.com for Crypt::CBC_R. -.SH "SEE ALSO" -Crypt::CBC, -Crypt::DES, -Crypt::IDEA -.PP -Bruce Schneier, \fIApplied Cryptography\fR, 1995, Second Edition, -published by John Wiley & Sons, Inc. -.SH "COPYRIGHT" -The implementation of the Blowfish algorithm was developed by, -and is copyright of, A.M. Kuchling. -.PP -Other parts of the perl extension and module are -copyright of Systemics Ltd ( http://www.systemics.com/ ). -.PP -Code revisions, updates, and standalone release are copyright -1999-2001 W3Works, LLC. -.SH "AUTHOR" -Original algorithm, Bruce Shneier. Original implementation, A.M. -Kuchling. Original Perl implementation, Systemics Ltd. Current -maintenance by W3Works, LLC. -.PP -Current revision and maintainer: Dave Paris <amused(a)pobox.com> - -.rn }` '' -.IX Title "Blowfish 3" -.IX Name "Crypt::Blowfish - Perl Blowfish encryption module" - -.IX Header "NAME" - -.IX Header "SYNOPSIS" - -.IX Header "DESCRIPTION" - -.IX Header "FUNCTIONS" - -.IX Item "blocksize" - -.IX Item "new" - -.IX Item "encrypt" - -.IX Item "decrypt" - -.IX Header "EXAMPLE" - -.IX Header "PLATFORMS" - -.IX Header "NOTES" - -.IX Header "SEE ALSO" - -.IX Header "COPYRIGHT" - -.IX Header "AUTHOR" - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blowfish.h b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blowfish.h deleted file mode 100644 index e1b9f76..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/blowfish.h +++ /dev/null @@ -1,6 +0,0 @@ -#include <sys/types.h> - -typedef unsigned char bf_cblock[8]; - -int blowfish_make_bfkey(char * key_string, int keylength, char * bfkey); -void blowfish_crypt_8bytes(bf_cblock source, bf_cblock dest, char * bfkey, short direction); diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/files.txt b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/files.txt deleted file mode 100644 index 5f6efcd..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/files.txt +++ /dev/null @@ -1,4 +0,0 @@ -/usr/lib/perl5/man/man3/Crypt::Blowfish.3 -/usr/lib/perl5/site_perl/5.005/i386-linux/Crypt/Blowfish.pm -/usr/lib/perl5/site_perl/5.005/i386-linux/auto/Crypt/Blowfish/Blowfish.bs -/usr/lib/perl5/site_perl/5.005/i386-linux/auto/Crypt/Blowfish/Blowfish.so diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/pm_to_blib b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/pm_to_blib deleted file mode 100644 index e69de29..0000000 diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/test.pl b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/test.pl deleted file mode 100644 index 4c1b84d..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/test.pl +++ /dev/null @@ -1,281 +0,0 @@ -BEGIN { push @INC, qw(. .. ../lib ../../lib ../../../lib) } - -package Crypt::Blowfish; - -require Exporter; -require DynaLoader; - -@ISA = (Exporter, DynaLoader); - -bootstrap Crypt::Blowfish; - - -use Benchmark qw(timediff timestr); -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - - -sub blocksize { 8; } -sub keysize { 56; } - -sub new -{ - usage("new Blowfish key") unless @_ == 2; - - my $type = shift; my $self = {}; bless $self, $type; - - $self->{'ks'} = Crypt::Blowfish::init(shift); - - $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 0); - - $data; -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - - my $self = shift; - my $data = shift; - - Crypt::Blowfish::crypt($data, $data, $self->{'ks'}, 1); - - $data; -} - - -package main; - - -# -# '6162636465666768696a6b6c6d6e6f707172737475767778797a', -# '424c4f5746495348', '324ed0fef413a203', -# -# '57686f206973204a6f686e2047616c743f', 'fedcba9876543210', 'cc91732b8022f684') -# -# "Ayn Rand" FEDCBA9876543210 e113f4102cfcce43 -# - -print "1..11\n"; - -my $key = pack("H*", "6162636465666768696a6b6c6d6e6f707172737475767778797a"); -my $in = pack("H*", "424c4f5746495348"); -my $out = pack("H*", "324ed0fef413a203"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 1\n"; - -my $key = pack("H*", "57686f206973204a6f686e2047616c743f"); -my $in = pack("H*", "fedcba9876543210"); -my $out = pack("H*", "cc91732b8022f684"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->decrypt($out) eq $in); -print "ok 2\n"; - -my $key = "Ayn Rand"; -substr($key, 3, 1) = pack("C", ord(substr($key, 3, 1))+128); -substr($key, 7, 1) = pack("C", ord(substr($key, 7, 1))+128); -my $in = pack("H*", "fedcba9876543210"); -my $out = pack("H*", "e113f4102cfcce43"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 3\n"; - -my $key = pack("H*", "0000000000000000"); -my $in = pack("H*", "0000000000000000"); -my $out = pack("H*", "4EF997456198DD78"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless($cipher->encrypt($in) eq $out); -print "ok 4\n"; - -my $key = pack("H*", "FFFFFFFFFFFFFFFF"); -my $in = pack("H*", "0000000000000000"); -my $out = pack("H*", "F21E9A77B71C49BC"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->decrypt($out) eq $in); -print "ok 5\n"; - -my $key = pack("H*", "FFFFFFFFFFFFFFFF"); -my $in = pack("H*", "FFFFFFFFFFFFFFFF"); -my $out = pack("H*", "51866FD5B85ECB8A"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 6\n"; - -my $key = pack("H*", "3000000000000000"); -my $in = pack("H*", "1000000000000001"); -my $out = pack("H*", "7D856F9A613063F2"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 7\n"; - -my $key = pack("H*", "1111111111111111"); -my $in = pack("H*", "1111111111111111"); -my $out = pack("H*", "2466DD878B963C9D"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 8\n"; - -my $key = pack("H*", "584023641ABA6176"); -my $in = pack("H*", "004BD6EF09176062"); -my $out = pack("H*", "452031C1E4FADA8E"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 9\n"; - -my $key = pack("H*", "0101010101010101"); -my $in = pack("H*", "0123456789ABCDEF"); -my $out = pack("H*", "FA34EC4847B268B2"); - -my $cipher = new Crypt::Blowfish $key; - -print "not " unless ($cipher->encrypt($in) eq $out); -print "ok 10\n"; - -{ - print "\nRunning standard mode speed tests.. encrypting with non-cached cipher\n"; - my $t0 = new Benchmark; - - for(1..5000){ - my $key = pack("H*", "0101010101010101"); - my $in = pack("H*", "0123456789ABCDEF"); - my $out = pack("H*", "FA34EC4847B268B2"); - - my $cipher = new Crypt::Blowfish $key; - $cipher->encrypt($in); - } - - my $t1 = new Benchmark; - my $td = Benchmark::timediff($t1,$t0); - my $ts = Benchmark::timestr($td); - - print "5,000 cycles: $ts\n"; - -}; # end standard mode (encrypt) speed test non-cached cipher - -{ - print "\nRunning standard mode speed tests.. decrypting with non-cached cipher\n"; - my $t0 = new Benchmark; - - for(1..5000){ - my $key = pack("H*", "0101010101010101"); - my $in = pack("H*", "0123456789ABCDEF"); - my $out = pack("H*", "FA34EC4847B268B2"); - - my $cipher = new Crypt::Blowfish $key; - $cipher->decrypt($out); - } - - my $t1 = new Benchmark; - my $td = Benchmark::timediff($t1,$t0); - my $ts = Benchmark::timestr($td); - - print "5,000 cycles: $ts\n"; - -}; # end standard mode (decrypt) speed test non-cached cipher - - -my $key = pack("H*", "0101010101010101"); -my $cipher = new Crypt::Blowfish $key; -{ - print "\nRunning standard mode speed tests.. encrypting with cached cipher\n"; - my $t0 = new Benchmark; - - for(1..10000){ - my $in = pack("H*", "0123456789ABCDEF"); - my $out = pack("H*", "FA34EC4847B268B2"); - - $cipher->encrypt($in); - } - - my $t1 = new Benchmark; - my $td = Benchmark::timediff($t1,$t0); - my $ts = Benchmark::timestr($td); - - print "10,000 cycles: $ts\n"; - - -}; # end standard mode (encrypt) speed test cached cipher - -{ - print "\nRunning standard mode speed tests.. decrypting with cached cipher\n"; - my $t0 = new Benchmark; - - for(1..10000){ - my $in = pack("H*", "0123456789ABCDEF"); - my $out = pack("H*", "FA34EC4847B268B2"); - - $cipher->decrypt($out); - } - - my $t1 = new Benchmark; - my $td = Benchmark::timediff($t1,$t0); - my $ts = Benchmark::timestr($td); - - print "10,000 cycles: $ts\n"; - - -}; # end standard mode (decrypt) speed test cached cipher - - -print "\nTesting Cipher Block Chaining..\n"; -eval 'use Crypt::CBC'; - -if(!$@) { - if($Crypt::CBC::VERSION < 1.22) { - $@ = "CBC mode requires Crypt::CBC version 1.22 or higher."; - } else { - - my $cipher = new Crypt::CBC(pack("H*","0123456789ABCDEFF0E1D2C3B4A59687"),"Blowfish"); - my $ciphertext = $cipher->encrypt(pack("H*","37363534333231204E6F77206973207468652074696D6520666F722000")); - my $plaintext = $cipher->decrypt($ciphertext); - - if($plaintext eq "7654321 Now is the time for \0") { - print "ok 11 - CBC Mode\n"; - } else { - print unpack("H*",$plaintext) . " :decrypted\n"; - print unpack("H*","7654321 Now is the time for \0") . " :orig\n"; - print "not ok 11 - CBC Mode failed\n"; - } - } -} # end no errors - -if($@) { - print "Error (probably harmless):\n$@\n"; -} - diff --git a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/typemap b/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/typemap deleted file mode 100644 index 02522e8..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-Blowfish-2.09/typemap +++ /dev/null @@ -1 +0,0 @@ -TYPEMAP diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/BUILD b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/BUILD deleted file mode 100644 index 74857ae..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/BUILD +++ /dev/null @@ -1,52 +0,0 @@ -# Macros - -%define cvs_package PerlModules/CPAN/Crypt-DES-2.03 - -# Package specific stuff -Name: perl-Crypt-DES -Version: 2.5.0 -Release: 1 -Packager: Karen Jacqmin-Adams <kja(a)redhat.com> -Summary: an XS-based DES implimentation for Perl. -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: i386 -Requires: perl -Requires: %(perl -MConfig -le 'if (defined $Config{useithreads}) { print "perl(:WITH_ITHREADS)" } else { print "perl(:WITHOUT_ITHREADS)" }') -Requires: %(perl -MConfig -le 'if (defined $Config{usethreads}) { print "perl(:WITH_THREADS)" } else { print "perl(:WITHOUT_THREADS)" }') -Requires: %(perl -MConfig -le 'if (defined $Config{uselargefiles}) { print "perl(:WITH_LARGEFILES)" } else { print "perl(:WITHOUT_LARGEFILES)" }') -Group: Development/Libraries -URL: http://search.cpan.org/dist/Crypt-DES/ -Copyright: Modifications, including cross-platform fixups, and single-algorithm distribution packaging are Copyright (C) 2000 W3Works, LLC. All Rights Reserved. Mail questions and comments to Dave Paris <amused(a)pobox.com>. Original distribution license (below) applies. Other parts of the library are covered by the following licence: Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) All rights reserved. -Vendor: Red Hat, Inc. -BuildRoot: %{_tmppath}/%name -Prefix: /usr - -%description - -The module implements the Crypt::CBC interface, which has the following methods -blocksize =item keysize =item encrypt =item decrypt - - -%prep -%entirely_abstract_build_step - - -%build -%makefile_build - - -%install -rm -rf $RPM_BUILD_ROOT -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION - -%cpan_doc_install -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - - -%files -f %{name}-%{version}-%{release}-filelist - - -%clean -%abstract_clean_script diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/COPYRIGHT b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/COPYRIGHT deleted file mode 100644 index fdc9031..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/COPYRIGHT +++ /dev/null @@ -1,50 +0,0 @@ -This perl extension includes software developed by Eric Young (eay(a)mincom.oz.au) - -Modifications, including cross-platform fixups, and single-algorithm distribution -packaging are Copyright (C) 2000 W3Works, LLC. All Rights Reserved. Mail -questions and comments to Dave Paris <amused(a)pobox.com>. Original distribution -license (below) applies. - -Other parts of the library are covered by the following licence: - -Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -All rights reserved. - -This library and applications are FREE FOR COMMERCIAL AND NON-COMMERCIAL USE -as long as the following conditions are adhered to. - -Copyright remains with Systemics Ltd, and as such any Copyright notices -in the code are not to be removed. If this code is used in a product, -Systemics should be given attribution as the author of the parts used. -This can be in the form of a textual message at program startup or -in documentation (online or textual) provided with the package. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: -1. Redistributions of source code must retain the copyright - notice, this list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. -3. All advertising materials mentioning features or use of this software - must display the following acknowledgement: - This product includes software developed by Systemics Ltd (http://www.systemics.com/) - - THIS SOFTWARE IS PROVIDED BY SYSTEMICS LTD ``AS IS'' AND - ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE - ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE - FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS - OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) - HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT - LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY - OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF - SUCH DAMAGE. - - The licence and distribution terms for any publically available version or - derivative of this code cannot be changed. i.e. this code cannot simply be - copied and put under another distribution licence - [including the GNU Public Licence.] - diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.pm b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.pm deleted file mode 100644 index 635bf50..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.pm +++ /dev/null @@ -1,172 +0,0 @@ -# -# Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -# All rights reserved. -# -# Modifications are Copyright (c) 2000, W3Works, LLC -# All Rights Reserved. - -package Crypt::DES; - -require Exporter; -require DynaLoader; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); - -@ISA = qw(Exporter DynaLoader); - -# Items to export into callers namespace by default -@EXPORT = qw(); - -# Other items we are prepared to export if requested -@EXPORT_OK = qw(); - -$VERSION = '2.03'; -bootstrap Crypt::DES $VERSION; - -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - - -sub blocksize { 8; } -sub keysize { 8; } - -sub new -{ - usage("new DES key") unless @_ == 2; - - my $type = shift; - my $self = {}; - bless $self, $type; - - $self->{'ks'} = Crypt::DES::expand_key(shift); - - return $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - - my ($self,$data) = @_; - return Crypt::DES::crypt($data, $data, $self->{'ks'}, 1); -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - - my ($self,$data) = @_; - return Crypt::DES::crypt($data, $data, $self->{'ks'}, 0); -} - -1; - -__END__ - -=head1 NAME - -Crypt::DES - Perl DES encryption module - -=head1 SYNOPSIS - - use Crypt::DES; - - -=head1 DESCRIPTION - -The module implements the Crypt::CBC interface, -which has the following methods - -=over 4 - -=item blocksize -=item keysize -=item encrypt -=item decrypt - -=back - -=head1 FUNCTIONS - -=over 4 - -=item blocksize - -Returns the size (in bytes) of the block cipher. - -=item keysize - -Returns the size (in bytes) of the key. Optimal size is 8 bytes. - -=item new - - my $cipher = new Crypt::DES $key; - -This creates a new Crypt::DES BlockCipher object, using $key, -where $key is a key of C<keysize()> bytes. - -=item encrypt - - my $cipher = new Crypt::DES $key; - my $ciphertext = $cipher->encrypt($plaintext); - -This function encrypts $plaintext and returns the $ciphertext -where $plaintext and $ciphertext should be of C<blocksize()> bytes. - -=item decrypt - - my $cipher = new Crypt::DES $key; - my $plaintext = $cipher->decrypt($ciphertext); - -This function decrypts $ciphertext and returns the $plaintext -where $plaintext and $ciphertext should be of C<blocksize()> bytes. - -=back - -=head1 EXAMPLE - - my $key = pack("H16", "0123456789ABCDEF"); - my $cipher = new Crypt::DES $key; - my $ciphertext = $cipher->encrypt("plaintex"); # NB - 8 bytes - print unpack("H16", $ciphertext), "\n"; - -=head1 NOTES - -Do note that DES only uses 8 byte keys and only works on 8 byte data -blocks. If you're intending to encrypt larger blocks or entire files, -please use Crypt::CBC in conjunction with this module. See the -Crypt::CBC documentation for proper syntax and use. - -Also note that the DES algorithm is, by today's standard, weak -encryption. Crypt::Blowfish is highly recommended if you're -interested in using strong encryption and a faster algorithm. - -=head1 SEE ALSO - -Crypt::Blowfish -Crypt::IDEA - -Bruce Schneier, I<Applied Cryptography>, 1995, Second Edition, -published by John Wiley & Sons, Inc. - -=head1 COPYRIGHT - -The implementation of the DES algorithm was developed by, -and is copyright of, Eric Young (eay(a)mincom.oz.au) -Other parts of the perl extension and module are -copyright of Systemics Ltd ( http://www.systemics.com/ ). -Cross-platform work and packaging for single algorithm -distribution is copyright of W3Works, LLC. - -=head1 MAINTAINER - -This single-algorithm package and cross-platform code is -maintained by Dave Paris <amused(a)pobox.com>. - -=cut diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.xs b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.xs deleted file mode 100644 index c8f3c0e..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/DES.xs +++ /dev/null @@ -1,90 +0,0 @@ -/* -* cross-platform and mod_ssl-safe code modifications are Copyright (C) -* 2000 W3Works, LLC. All rights reserved. -*/ - -/* - * Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) - * All rights reserved. - */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -typedef unsigned char i8; -typedef unsigned long i32; - -#include "des.h" - -#ifndef sv_undef -#define sv_undef PL_sv_undef -#endif - -MODULE = Crypt::DES PACKAGE = Crypt::DES PREFIX = des_ -PROTOTYPES: DISABLE - -char * -des_expand_key(key) - char * key = NO_INIT - STRLEN key_len = NO_INIT - CODE: - { - des_ks ks; - - key = (char *) SvPV(ST(0), key_len); - if (key_len != sizeof(des_user_key)) - croak("Invalid key"); - - perl_des_expand_key((i8 *)key, ks); - - ST(0) = sv_2mortal(newSVpv((char *)ks, sizeof(ks))); - } - -void -des_crypt(input, output, ks, enc_flag) - char * input = NO_INIT - SV * output - char * ks = NO_INIT - int enc_flag - STRLEN input_len = NO_INIT - STRLEN output_len = NO_INIT - STRLEN ks_len = NO_INIT - CODE: - { - input = (char *) SvPV(ST(0), input_len); - if (input_len != 8) - croak("input must be 8 bytes long"); - - ks = (char *) SvPV(ST(2), ks_len); - if (ks_len != sizeof(des_ks)) - croak("Invalid key schedule"); - - if (output == &sv_undef) - output = sv_newmortal(); - output_len = 8; - - if (!SvUPGRADE(output, SVt_PV)) - croak("cannot use output argument as lvalue"); - - perl_des_crypt(input, SvGROW(output, output_len), (i32 *)ks, enc_flag); - - SvCUR_set(output, output_len); - *SvEND(output) = '\0'; - (void) SvPOK_only(output); - SvTAINT(output); - - ST(0) = output; - } - - - - - - - - - - - - diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/MANIFEST b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/MANIFEST deleted file mode 100644 index b2cf6d9..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/MANIFEST +++ /dev/null @@ -1,10 +0,0 @@ -COPYRIGHT -DES.pm -DES.xs -MANIFEST -README -Makefile.PL -_des.c -des.h -test.pl -typemap diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/Makefile.PL b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/Makefile.PL deleted file mode 100755 index e136c37..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/Makefile.PL +++ /dev/null @@ -1,16 +0,0 @@ -#! /usr/local/bin/perl - -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile being created. - -require 5.004; - -WriteMakefile( - 'NAME' => 'Crypt::DES', - 'DISTNAME' => 'Crypt-DES', - 'VERSION_FROM' => 'DES.pm',, - 'OBJECT' => 'DES.o _des.o', - 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'} -); - diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/README b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/README deleted file mode 100644 index 2a99fb0..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/README +++ /dev/null @@ -1,83 +0,0 @@ -Crypt::DES - an XS-based DES implimentation for Perl. - -The 2.XX tree represents a major improvement over the -1.XX tree. This package builds on big-endian -machines and many more x86 platforms than before. -(with a few rare exceptions, like gcc on DUX against -5.004). - -mod_ssl conflicts have also been resolved. Thank you -to Jan 'Kozo' Vajda for pointing out the des_SPtrans -overlap between these two packages. - -Prerequisites -------------- - -For the full test suite to run, Crypt::CBC, version 1.22 or higher -is required (recommended is 1.25 or higher), however this module -is not mandatory for standalone DES use, and all other tests -will run to completion. - -Installing Crypt::DES ---------------------- - -nothing unusual: - - 1. perl Makefile.PL - 2. make - 3. make test - 4. make install - -Notes ------ - -The following is a list of known good platforms: -FreeBSD 3.5-RELEASE / x86 / 5.005 -OpenBSD 2.7 / x86 / 5.6 -Linux / x86 / 5.005 & 5.6 -Linux / PPC / 5.005 & 5.6 -Solaris7 / SPARC / 5.005 -Solaris / x86 / 5.005 -DUX / Alpha / 5.005 (using DEC cc) -Win32 / x86 / 5.005 (using VC++5) -OS/2 / x86 / 5.6 - -Reports of builds against 5.004 have been equally -positive. Building on Win32 with VC++6 may prove -problematic. Complaints about build problems on -Win32 will be sent to /dev/null. - -Please report any other successful OS/Platform -combinations to amused(a)pobox.com. Thank you. - -What you can expect in the way of speed: - -Linux/x86 dual PII400 -non-cached cipher speed test. 5000 encrypt iterations - 0 wallclock secs ( 0.52 usr + 0.01 sys = 0.53 CPU) -non-cached cipher speed test. 5000 decrypt iterations - 1 wallclock secs ( 0.52 usr + 0.01 sys = 0.53 CPU) -cached cipher speed test. 10000 encrypt iterations - 0 wallclock secs ( 0.20 usr + 0.00 sys = 0.20 CPU) -cached cipher speed test. 10000 decrypt iterations - 0 wallclock secs ( 0.22 usr + 0.00 sys = 0.22 CPU) - -Windows NT4(SP6)/x86 dual PPro 200 -non-cached cipher speed test. 5000 encrypt iterations - 1 wallclock secs ( 1.25 usr + 0.00 sys = 1.25 CPU) -non-cached cipher speed test. 5000 decrypt iterations - 2 wallclock secs ( 1.22 usr + 0.00 sys = 1.22 CPU) -cached cipher speed test. 10000 encrypt iterations - 0 wallclock secs ( 0.58 usr + 0.00 sys = 0.58 CPU) -cached cipher speed test. 10000 decrypt iterations - 1 wallclock secs ( 0.59 usr + 0.00 sys = 0.59 CPU) - -Solaris7/SPARC UltraSPARCIIi 277Mhz -non-cached cipher speed test. 5000 encrypt iterations - 1 wallclock secs ( 1.08 usr + 0.20 sys = 1.28 CPU) -non-cached cipher speed test. 5000 decrypt iterations - 2 wallclock secs ( 1.14 usr + 0.12 sys = 1.26 CPU) -cached cipher speed test. 10000 encrypt iterations - 0 wallclock secs ( 0.52 usr + 0.00 sys = 0.52 CPU) -cached cipher speed test. 10000 decrypt iterations - 1 wallclock secs ( 0.50 usr + 0.00 sys = 0.50 CPU) diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/_des.c b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/_des.c deleted file mode 100644 index 1c5ca84..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/_des.c +++ /dev/null @@ -1,591 +0,0 @@ -/* -* cross-platform and mod_ssl-safe code modifications are Copyright (C) -* 2000 W3Works, LLC. All rights reserved. -*/ - -/* -* The modifications found herein are Copyright (C) W3Works, LLC. -# All rights reserved. -*/ - -/* - * NB - This file is a modified version of one by Eric Young. - * It was modifed by Systemics Ltd (http://www.systemics.com/) - */ - -/* Copyright (C) 1995 Eric Young (eay(a)mincom.oz.au) -* All rights reserved. -* -* This file is part of an SSL implementation written -* by Eric Young (eay(a)mincom.oz.au) -* The implementation was written so as to conform with Netscapes SSL -* specification. This library and applications are -* FREE FOR COMMERCIAL AND NON-COMMERCIAL USE -* as long as the following conditions are aheared to. -* -* Copyright remains Eric Young's, and as such any Copyright notices in -* the code are not to be removed. If this code is used in a product, -* Eric Young should be given attribution as the author of the parts used. -* This can be in the form of a textual message at program startup or -* in documentation (online or textual) provided with the package. -* -* Redistribution and use in source and binary forms, with or without -* modification, are permitted provided that the following conditions -* are met: -* 1. Redistributions of source code must retain the copyright -* notice, this list of conditions and the following disclaimer. -* 2. Redistributions in binary form must reproduce the above copyright -* notice, this list of conditions and the following disclaimer in the -* documentation and/or other materials provided with the distribution. -* 3. All advertising materials mentioning features or use of this software -* must display the following acknowledgement: -* This product includes software developed by Eric Young (eay(a)mincom.oz.au) -* -* THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND -* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE -* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE -* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS -* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) -* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT -* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY -* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF -* SUCH DAMAGE. -* -* The licence and distribution terms for any publically available version or -* derivative of this code cannot be changed. i.e. this code cannot simply be -* copied and put under another distribution licence -* [including the GNU Public Licence.] -*/ - -#include "des.h" - -#define c2l(c,l) (l =((unsigned long)(*((c)++))), \ - l|=((unsigned long)(*((c)++)))<< 8, \ - l|=((unsigned long)(*((c)++)))<<16, \ - l|=((unsigned long)(*((c)++)))<<24) - -#define l2c(l,c) (*((c)++)=(unsigned char)(((l) )&0xff), \ - *((c)++)=(unsigned char)(((l)>> 8)&0xff), \ - *((c)++)=(unsigned char)(((l)>>16)&0xff), \ - *((c)++)=(unsigned char)(((l)>>24)&0xff)) - -#define ITERATIONS 16 -#define HPERM_OP(a,t,n,m) ((t)=((((a)<<(16-(n)))^(a))&(m)),\ - (a)=(a)^(t)^(t>>(16-(n)))) - - -unsigned long des_SPtrans_x[8][64]={ -/* nibble 0 */ -0x00820200, 0x00020000, 0x80800000, 0x80820200, -0x00800000, 0x80020200, 0x80020000, 0x80800000, -0x80020200, 0x00820200, 0x00820000, 0x80000200, -0x80800200, 0x00800000, 0x00000000, 0x80020000, -0x00020000, 0x80000000, 0x00800200, 0x00020200, -0x80820200, 0x00820000, 0x80000200, 0x00800200, -0x80000000, 0x00000200, 0x00020200, 0x80820000, -0x00000200, 0x80800200, 0x80820000, 0x00000000, -0x00000000, 0x80820200, 0x00800200, 0x80020000, -0x00820200, 0x00020000, 0x80000200, 0x00800200, -0x80820000, 0x00000200, 0x00020200, 0x80800000, -0x80020200, 0x80000000, 0x80800000, 0x00820000, -0x80820200, 0x00020200, 0x00820000, 0x80800200, -0x00800000, 0x80000200, 0x80020000, 0x00000000, -0x00020000, 0x00800000, 0x80800200, 0x00820200, -0x80000000, 0x80820000, 0x00000200, 0x80020200, - -/* nibble 1 */ -0x10042004, 0x00000000, 0x00042000, 0x10040000, -0x10000004, 0x00002004, 0x10002000, 0x00042000, -0x00002000, 0x10040004, 0x00000004, 0x10002000, -0x00040004, 0x10042000, 0x10040000, 0x00000004, -0x00040000, 0x10002004, 0x10040004, 0x00002000, -0x00042004, 0x10000000, 0x00000000, 0x00040004, -0x10002004, 0x00042004, 0x10042000, 0x10000004, -0x10000000, 0x00040000, 0x00002004, 0x10042004, -0x00040004, 0x10042000, 0x10002000, 0x00042004, -0x10042004, 0x00040004, 0x10000004, 0x00000000, -0x10000000, 0x00002004, 0x00040000, 0x10040004, -0x00002000, 0x10000000, 0x00042004, 0x10002004, -0x10042000, 0x00002000, 0x00000000, 0x10000004, -0x00000004, 0x10042004, 0x00042000, 0x10040000, -0x10040004, 0x00040000, 0x00002004, 0x10002000, -0x10002004, 0x00000004, 0x10040000, 0x00042000, - -/* nibble 2 */ -0x41000000, 0x01010040, 0x00000040, 0x41000040, -0x40010000, 0x01000000, 0x41000040, 0x00010040, -0x01000040, 0x00010000, 0x01010000, 0x40000000, -0x41010040, 0x40000040, 0x40000000, 0x41010000, -0x00000000, 0x40010000, 0x01010040, 0x00000040, -0x40000040, 0x41010040, 0x00010000, 0x41000000, -0x41010000, 0x01000040, 0x40010040, 0x01010000, -0x00010040, 0x00000000, 0x01000000, 0x40010040, -0x01010040, 0x00000040, 0x40000000, 0x00010000, -0x40000040, 0x40010000, 0x01010000, 0x41000040, -0x00000000, 0x01010040, 0x00010040, 0x41010000, -0x40010000, 0x01000000, 0x41010040, 0x40000000, -0x40010040, 0x41000000, 0x01000000, 0x41010040, -0x00010000, 0x01000040, 0x41000040, 0x00010040, -0x01000040, 0x00000000, 0x41010000, 0x40000040, -0x41000000, 0x40010040, 0x00000040, 0x01010000, - -/* nibble 3 */ -0x00100402, 0x04000400, 0x00000002, 0x04100402, -0x00000000, 0x04100000, 0x04000402, 0x00100002, -0x04100400, 0x04000002, 0x04000000, 0x00000402, -0x04000002, 0x00100402, 0x00100000, 0x04000000, -0x04100002, 0x00100400, 0x00000400, 0x00000002, -0x00100400, 0x04000402, 0x04100000, 0x00000400, -0x00000402, 0x00000000, 0x00100002, 0x04100400, -0x04000400, 0x04100002, 0x04100402, 0x00100000, -0x04100002, 0x00000402, 0x00100000, 0x04000002, -0x00100400, 0x04000400, 0x00000002, 0x04100000, -0x04000402, 0x00000000, 0x00000400, 0x00100002, -0x00000000, 0x04100002, 0x04100400, 0x00000400, -0x04000000, 0x04100402, 0x00100402, 0x00100000, -0x04100402, 0x00000002, 0x04000400, 0x00100402, -0x00100002, 0x00100400, 0x04100000, 0x04000402, -0x00000402, 0x04000000, 0x04000002, 0x04100400, - -/* nibble 4 */ -0x02000000, 0x00004000, 0x00000100, 0x02004108, -0x02004008, 0x02000100, 0x00004108, 0x02004000, -0x00004000, 0x00000008, 0x02000008, 0x00004100, -0x02000108, 0x02004008, 0x02004100, 0x00000000, -0x00004100, 0x02000000, 0x00004008, 0x00000108, -0x02000100, 0x00004108, 0x00000000, 0x02000008, -0x00000008, 0x02000108, 0x02004108, 0x00004008, -0x02004000, 0x00000100, 0x00000108, 0x02004100, -0x02004100, 0x02000108, 0x00004008, 0x02004000, -0x00004000, 0x00000008, 0x02000008, 0x02000100, -0x02000000, 0x00004100, 0x02004108, 0x00000000, -0x00004108, 0x02000000, 0x00000100, 0x00004008, -0x02000108, 0x00000100, 0x00000000, 0x02004108, -0x02004008, 0x02004100, 0x00000108, 0x00004000, -0x00004100, 0x02004008, 0x02000100, 0x00000108, -0x00000008, 0x00004108, 0x02004000, 0x02000008, - -/* nibble 5 */ -0x20000010, 0x00080010, 0x00000000, 0x20080800, -0x00080010, 0x00000800, 0x20000810, 0x00080000, -0x00000810, 0x20080810, 0x00080800, 0x20000000, -0x20000800, 0x20000010, 0x20080000, 0x00080810, -0x00080000, 0x20000810, 0x20080010, 0x00000000, -0x00000800, 0x00000010, 0x20080800, 0x20080010, -0x20080810, 0x20080000, 0x20000000, 0x00000810, -0x00000010, 0x00080800, 0x00080810, 0x20000800, -0x00000810, 0x20000000, 0x20000800, 0x00080810, -0x20080800, 0x00080010, 0x00000000, 0x20000800, -0x20000000, 0x00000800, 0x20080010, 0x00080000, -0x00080010, 0x20080810, 0x00080800, 0x00000010, -0x20080810, 0x00080800, 0x00080000, 0x20000810, -0x20000010, 0x20080000, 0x00080810, 0x00000000, -0x00000800, 0x20000010, 0x20000810, 0x20080800, -0x20080000, 0x00000810, 0x00000010, 0x20080010, - -/* nibble 6 */ -0x00001000, 0x00000080, 0x00400080, 0x00400001, -0x00401081, 0x00001001, 0x00001080, 0x00000000, -0x00400000, 0x00400081, 0x00000081, 0x00401000, -0x00000001, 0x00401080, 0x00401000, 0x00000081, -0x00400081, 0x00001000, 0x00001001, 0x00401081, -0x00000000, 0x00400080, 0x00400001, 0x00001080, -0x00401001, 0x00001081, 0x00401080, 0x00000001, -0x00001081, 0x00401001, 0x00000080, 0x00400000, -0x00001081, 0x00401000, 0x00401001, 0x00000081, -0x00001000, 0x00000080, 0x00400000, 0x00401001, -0x00400081, 0x00001081, 0x00001080, 0x00000000, -0x00000080, 0x00400001, 0x00000001, 0x00400080, -0x00000000, 0x00400081, 0x00400080, 0x00001080, -0x00000081, 0x00001000, 0x00401081, 0x00400000, -0x00401080, 0x00000001, 0x00001001, 0x00401081, -0x00400001, 0x00401080, 0x00401000, 0x00001001, - -/* nibble 7 */ -0x08200020, 0x08208000, 0x00008020, 0x00000000, -0x08008000, 0x00200020, 0x08200000, 0x08208020, -0x00000020, 0x08000000, 0x00208000, 0x00008020, -0x00208020, 0x08008020, 0x08000020, 0x08200000, -0x00008000, 0x00208020, 0x00200020, 0x08008000, -0x08208020, 0x08000020, 0x00000000, 0x00208000, -0x08000000, 0x00200000, 0x08008020, 0x08200020, -0x00200000, 0x00008000, 0x08208000, 0x00000020, -0x00200000, 0x00008000, 0x08000020, 0x08208020, -0x00008020, 0x08000000, 0x00000000, 0x00208000, -0x08200020, 0x08008020, 0x08008000, 0x00200020, -0x08208000, 0x00000020, 0x00200020, 0x08008000, -0x08208020, 0x00200000, 0x08200000, 0x08000020, -0x00208000, 0x00008020, 0x08008020, 0x08200000, -0x00000020, 0x08208000, 0x00208020, 0x00000000, -0x08000000, 0x08200020, 0x00008000, 0x00208020}; - -unsigned long des_skb[8][64]={ -/* for C bits (numbered as per FIPS 46) 1 2 3 4 5 6 */ -0x00000000,0x00000010,0x20000000,0x20000010, -0x00010000,0x00010010,0x20010000,0x20010010, -0x00000800,0x00000810,0x20000800,0x20000810, -0x00010800,0x00010810,0x20010800,0x20010810, -0x00000020,0x00000030,0x20000020,0x20000030, -0x00010020,0x00010030,0x20010020,0x20010030, -0x00000820,0x00000830,0x20000820,0x20000830, -0x00010820,0x00010830,0x20010820,0x20010830, -0x00080000,0x00080010,0x20080000,0x20080010, -0x00090000,0x00090010,0x20090000,0x20090010, -0x00080800,0x00080810,0x20080800,0x20080810, -0x00090800,0x00090810,0x20090800,0x20090810, -0x00080020,0x00080030,0x20080020,0x20080030, -0x00090020,0x00090030,0x20090020,0x20090030, -0x00080820,0x00080830,0x20080820,0x20080830, -0x00090820,0x00090830,0x20090820,0x20090830, -/* for C bits (numbered as per FIPS 46) 7 8 10 11 12 13 */ -0x00000000,0x02000000,0x00002000,0x02002000, -0x00200000,0x02200000,0x00202000,0x02202000, -0x00000004,0x02000004,0x00002004,0x02002004, -0x00200004,0x02200004,0x00202004,0x02202004, -0x00000400,0x02000400,0x00002400,0x02002400, -0x00200400,0x02200400,0x00202400,0x02202400, -0x00000404,0x02000404,0x00002404,0x02002404, -0x00200404,0x02200404,0x00202404,0x02202404, -0x10000000,0x12000000,0x10002000,0x12002000, -0x10200000,0x12200000,0x10202000,0x12202000, -0x10000004,0x12000004,0x10002004,0x12002004, -0x10200004,0x12200004,0x10202004,0x12202004, -0x10000400,0x12000400,0x10002400,0x12002400, -0x10200400,0x12200400,0x10202400,0x12202400, -0x10000404,0x12000404,0x10002404,0x12002404, -0x10200404,0x12200404,0x10202404,0x12202404, -/* for C bits (numbered as per FIPS 46) 14 15 16 17 19 20 */ -0x00000000,0x00000001,0x00040000,0x00040001, -0x01000000,0x01000001,0x01040000,0x01040001, -0x00000002,0x00000003,0x00040002,0x00040003, -0x01000002,0x01000003,0x01040002,0x01040003, -0x00000200,0x00000201,0x00040200,0x00040201, -0x01000200,0x01000201,0x01040200,0x01040201, -0x00000202,0x00000203,0x00040202,0x00040203, -0x01000202,0x01000203,0x01040202,0x01040203, -0x08000000,0x08000001,0x08040000,0x08040001, -0x09000000,0x09000001,0x09040000,0x09040001, -0x08000002,0x08000003,0x08040002,0x08040003, -0x09000002,0x09000003,0x09040002,0x09040003, -0x08000200,0x08000201,0x08040200,0x08040201, -0x09000200,0x09000201,0x09040200,0x09040201, -0x08000202,0x08000203,0x08040202,0x08040203, -0x09000202,0x09000203,0x09040202,0x09040203, -/* for C bits (numbered as per FIPS 46) 21 23 24 26 27 28 */ -0x00000000,0x00100000,0x00000100,0x00100100, -0x00000008,0x00100008,0x00000108,0x00100108, -0x00001000,0x00101000,0x00001100,0x00101100, -0x00001008,0x00101008,0x00001108,0x00101108, -0x04000000,0x04100000,0x04000100,0x04100100, -0x04000008,0x04100008,0x04000108,0x04100108, -0x04001000,0x04101000,0x04001100,0x04101100, -0x04001008,0x04101008,0x04001108,0x04101108, -0x00020000,0x00120000,0x00020100,0x00120100, -0x00020008,0x00120008,0x00020108,0x00120108, -0x00021000,0x00121000,0x00021100,0x00121100, -0x00021008,0x00121008,0x00021108,0x00121108, -0x04020000,0x04120000,0x04020100,0x04120100, -0x04020008,0x04120008,0x04020108,0x04120108, -0x04021000,0x04121000,0x04021100,0x04121100, -0x04021008,0x04121008,0x04021108,0x04121108, -/* for D bits (numbered as per FIPS 46) 1 2 3 4 5 6 */ -0x00000000,0x10000000,0x00010000,0x10010000, -0x00000004,0x10000004,0x00010004,0x10010004, -0x20000000,0x30000000,0x20010000,0x30010000, -0x20000004,0x30000004,0x20010004,0x30010004, -0x00100000,0x10100000,0x00110000,0x10110000, -0x00100004,0x10100004,0x00110004,0x10110004, -0x20100000,0x30100000,0x20110000,0x30110000, -0x20100004,0x30100004,0x20110004,0x30110004, -0x00001000,0x10001000,0x00011000,0x10011000, -0x00001004,0x10001004,0x00011004,0x10011004, -0x20001000,0x30001000,0x20011000,0x30011000, -0x20001004,0x30001004,0x20011004,0x30011004, -0x00101000,0x10101000,0x00111000,0x10111000, -0x00101004,0x10101004,0x00111004,0x10111004, -0x20101000,0x30101000,0x20111000,0x30111000, -0x20101004,0x30101004,0x20111004,0x30111004, -/* for D bits (numbered as per FIPS 46) 8 9 11 12 13 14 */ -0x00000000,0x08000000,0x00000008,0x08000008, -0x00000400,0x08000400,0x00000408,0x08000408, -0x00020000,0x08020000,0x00020008,0x08020008, -0x00020400,0x08020400,0x00020408,0x08020408, -0x00000001,0x08000001,0x00000009,0x08000009, -0x00000401,0x08000401,0x00000409,0x08000409, -0x00020001,0x08020001,0x00020009,0x08020009, -0x00020401,0x08020401,0x00020409,0x08020409, -0x02000000,0x0A000000,0x02000008,0x0A000008, -0x02000400,0x0A000400,0x02000408,0x0A000408, -0x02020000,0x0A020000,0x02020008,0x0A020008, -0x02020400,0x0A020400,0x02020408,0x0A020408, -0x02000001,0x0A000001,0x02000009,0x0A000009, -0x02000401,0x0A000401,0x02000409,0x0A000409, -0x02020001,0x0A020001,0x02020009,0x0A020009, -0x02020401,0x0A020401,0x02020409,0x0A020409, -/* for D bits (numbered as per FIPS 46) 16 17 18 19 20 21 */ -0x00000000,0x00000100,0x00080000,0x00080100, -0x01000000,0x01000100,0x01080000,0x01080100, -0x00000010,0x00000110,0x00080010,0x00080110, -0x01000010,0x01000110,0x01080010,0x01080110, -0x00200000,0x00200100,0x00280000,0x00280100, -0x01200000,0x01200100,0x01280000,0x01280100, -0x00200010,0x00200110,0x00280010,0x00280110, -0x01200010,0x01200110,0x01280010,0x01280110, -0x00000200,0x00000300,0x00080200,0x00080300, -0x01000200,0x01000300,0x01080200,0x01080300, -0x00000210,0x00000310,0x00080210,0x00080310, -0x01000210,0x01000310,0x01080210,0x01080310, -0x00200200,0x00200300,0x00280200,0x00280300, -0x01200200,0x01200300,0x01280200,0x01280300, -0x00200210,0x00200310,0x00280210,0x00280310, -0x01200210,0x01200310,0x01280210,0x01280310, -/* for D bits (numbered as per FIPS 46) 22 23 24 25 27 28 */ -0x00000000,0x04000000,0x00040000,0x04040000, -0x00000002,0x04000002,0x00040002,0x04040002, -0x00002000,0x04002000,0x00042000,0x04042000, -0x00002002,0x04002002,0x00042002,0x04042002, -0x00000020,0x04000020,0x00040020,0x04040020, -0x00000022,0x04000022,0x00040022,0x04040022, -0x00002020,0x04002020,0x00042020,0x04042020, -0x00002022,0x04002022,0x00042022,0x04042022, -0x00000800,0x04000800,0x00040800,0x04040800, -0x00000802,0x04000802,0x00040802,0x04040802, -0x00002800,0x04002800,0x00042800,0x04042800, -0x00002802,0x04002802,0x00042802,0x04042802, -0x00000820,0x04000820,0x00040820,0x04040820, -0x00000822,0x04000822,0x00040822,0x04040822, -0x00002820,0x04002820,0x00042820,0x04042820, -0x00002822,0x04002822,0x00042822,0x04042822, -}; - - - - - - - -/* The changes to this macro may help or hinder, depending on the - * compiler and the achitecture. gcc2 always seems to do well :-). - * Inspired by Dana How <how(a)isl.stanford.edu> - * DO NOT use the alternative version on machines with 8 byte longs. */ - -#ifdef ALT_ECB -#define D_ENCRYPT(L,R,S) \ - u=((R^s[S ])<<2); \ - t= R^s[S+1]; \ - t=((t>>2)+(t<<30)); \ - L^= \ - *(unsigned long *)(des_SP+0x0100+((t )&0xfc))+ \ - *(unsigned long *)(des_SP+0x0300+((t>> 8)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0500+((t>>16)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0700+((t>>24)&0xfc))+ \ - *(unsigned long *)(des_SP+ ((u )&0xfc))+ \ - *(unsigned long *)(des_SP+0x0200+((u>> 8)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0400+((u>>16)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0600+((u>>24)&0xfc)); -#else /* original version */ -#define D_ENCRYPT(L,R,S) \ - u=(R^s[S ]); \ - t=R^s[S+1]; \ - t=((t>>4)+(t<<28)); \ - L^= des_SPtrans_x[1][(t )&0x3f]| \ - des_SPtrans_x[3][(t>> 8)&0x3f]| \ - des_SPtrans_x[5][(t>>16)&0x3f]| \ - des_SPtrans_x[7][(t>>24)&0x3f]| \ - des_SPtrans_x[0][(u )&0x3f]| \ - des_SPtrans_x[2][(u>> 8)&0x3f]| \ - des_SPtrans_x[4][(u>>16)&0x3f]| \ - des_SPtrans_x[6][(u>>24)&0x3f]; -#endif - - /* IP and FP - * The problem is more of a geometric problem that random bit fiddling. - 0 1 2 3 4 5 6 7 62 54 46 38 30 22 14 6 - 8 9 10 11 12 13 14 15 60 52 44 36 28 20 12 4 - 16 17 18 19 20 21 22 23 58 50 42 34 26 18 10 2 - 24 25 26 27 28 29 30 31 to 56 48 40 32 24 16 8 0 - - 32 33 34 35 36 37 38 39 63 55 47 39 31 23 15 7 - 40 41 42 43 44 45 46 47 61 53 45 37 29 21 13 5 - 48 49 50 51 52 53 54 55 59 51 43 35 27 19 11 3 - 56 57 58 59 60 61 62 63 57 49 41 33 25 17 9 1 - - The output has been subject to swaps of the form - 0 1 -> 3 1 but the odd and even bits have been put into - 2 3 2 0 - different words. The main trick is to remember that - t=((l>>size)^r)&(mask); - r^=t; - l^=(t<<size); - can be used to swap and move bits between words. - - So l = 0 1 2 3 r = 16 17 18 19 - 4 5 6 7 20 21 22 23 - 8 9 10 11 24 25 26 27 - 12 13 14 15 28 29 30 31 - becomes (for size == 2 and mask == 0x3333) - t = 2^16 3^17 -- -- l = 0 1 16 17 r = 2 3 18 19 - 6^20 7^21 -- -- 4 5 20 21 6 7 22 23 - 10^24 11^25 -- -- 8 9 24 25 10 11 24 25 - 14^28 15^29 -- -- 12 13 28 29 14 15 28 29 - - Thanks for hints from Richard Outerbridge - he told me IP&FP - could be done in 15 xor, 10 shifts and 5 ands. - When I finally started to think of the problem in 2D - I first got ~42 operations without xors. When I remembered - how to use xors :-) I got it to its final state. - */ -#define PERM_OP(a,b,t,n,m) ((t)=((((a)>>(n))^(b))&(m)),\ - (b)^=(t),\ - (a)^=((t)<<(n))) - - -void -perl_des_crypt( des_cblock input, des_cblock output, des_ks ks, int encrypt ) -{ - unsigned long l,r,t,u; -#ifdef ALT_ECB - unsigned char *des_SP=(unsigned char *)des_SPtrans_x; -#endif - static int i; - static unsigned long * s; - unsigned char * ptr; - - c2l( input, l ); /* get endian free long from input block */ - c2l( input, r ); /* get endian free long from input block */ - - /* do IP */ - PERM_OP(r,l,t, 4,0x0f0f0f0f); - PERM_OP(l,r,t,16,0x0000ffff); - PERM_OP(r,l,t, 2,0x33333333); - PERM_OP(l,r,t, 8,0x00ff00ff); - PERM_OP(r,l,t, 1,0x55555555); - /* r and l are reversed - remember that :-) - fix - * it in the next step */ - - /* Things have been modified so that the initial rotate is - * done outside the loop. This required the - * des_SPtrans_x values in sp.h to be rotated 1 bit to the right. - * One perl script later and things have a 5% speed up on a sparc2. - * Thanks to Richard Outerbridge <71755.204(a)CompuServe.COM> - * for pointing this out. */ - t=(r<<1)|(r>>31); - r=(l<<1)|(l>>31); - l=t; - - /* clear the top bits on machines with 8byte longs */ - l&=0xffffffff; - r&=0xffffffff; - - s=(unsigned long *)ks; - /* I don't know if it is worth the effort of loop unrolling the - * inner loop */ - if (encrypt) - { - for (i=0; i<32; i+=4) - { - D_ENCRYPT(l,r,i+0); /* 1 */ - D_ENCRYPT(r,l,i+2); /* 2 */ - } - } - else - { - for (i=30; i>0; i-=4) - { - D_ENCRYPT(l,r,i-0); /* 16 */ - D_ENCRYPT(r,l,i-2); /* 15 */ - } - } - l=(l>>1)|(l<<31); - r=(r>>1)|(r<<31); - /* clear the top bits on machines with 8byte longs */ - l&=0xffffffff; - r&=0xffffffff; - - /* swap l and r - * we will not do the swap so just remember they are - * reversed for the rest of the subroutine - * luckily FP fixes this problem :-) */ - - PERM_OP(r,l,t, 1,0x55555555); - PERM_OP(l,r,t, 8,0x00ff00ff); - PERM_OP(r,l,t, 2,0x33333333); - PERM_OP(l,r,t,16,0x0000ffff); - PERM_OP(r,l,t, 4,0x0f0f0f0f); - - l2c( l, output ); /* get endian free long from input block */ - l2c( r, output ); /* get endian free long from input block */ -} - -void -perl_des_expand_key(des_user_key userKey, des_ks ks) -{ - unsigned long c,d,t,s; - unsigned char * in; - unsigned long * k; - int i; - static unsigned char shifts2[16]={0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0}; - - k=(unsigned long *)ks; - in=(unsigned char *)userKey; - - c2l(in,c); - c2l(in,d); - -/* do PC1 in 60 simple operations */ -/* PERM_OP(d,c,t,4,0x0f0f0f0f); - HPERM_OP(c,t,-2, 0xcccc0000); - HPERM_OP(c,t,-1, 0xaaaa0000); - HPERM_OP(c,t, 8, 0x00ff0000); - HPERM_OP(c,t,-1, 0xaaaa0000); - HPERM_OP(d,t,-8, 0xff000000); - HPERM_OP(d,t, 8, 0x00ff0000); - HPERM_OP(d,t, 2, 0x33330000); - d=((d&0x00aa00aa)<<7)|((d&0x55005500)>>7)|(d&0xaa55aa55); - d=(d>>8)|((c&0xf0000000)>>4); - c&=0x0fffffff; */ - - /* I now do it in 47 simple operations :-) - * Thanks to John Fletcher (john_fletcher(a)lccmail.ocf.llnl.gov) - * for the inspiration. :-) */ - PERM_OP (d,c,t,4,0x0f0f0f0f); - HPERM_OP(c,t,-2,0xcccc0000); - HPERM_OP(d,t,-2,0xcccc0000); - PERM_OP (d,c,t,1,0x55555555); - PERM_OP (c,d,t,8,0x00ff00ff); - PERM_OP (d,c,t,1,0x55555555); - d= (((d&0x000000ff)<<16)| (d&0x0000ff00) | - ((d&0x00ff0000)>>16)|((c&0xf0000000)>>4)); - c&=0x0fffffff; - - for (i=0; i<ITERATIONS; i++) - { - if (shifts2[i]) - { c=((c>>2)|(c<<26)); d=((d>>2)|(d<<26)); } - else - { c=((c>>1)|(c<<27)); d=((d>>1)|(d<<27)); } - c&=0x0fffffff; - d&=0x0fffffff; - /* could be a few less shifts but I am to lazy at this - * point in time to investigate */ - s=des_skb[0][ (c )&0x3f ]| - des_skb[1][((c>> 6)&0x03)|((c>> 7)&0x3c)]| - des_skb[2][((c>>13)&0x0f)|((c>>14)&0x30)]| - des_skb[3][((c>>20)&0x01)|((c>>21)&0x06) | - ((c>>22)&0x38)]; - - t=des_skb[4][ (d )&0x3f ]| - des_skb[5][((d>> 7)&0x03)|((d>> 8)&0x3c)]| - des_skb[6][ (d>>15)&0x3f ]| - des_skb[7][((d>>21)&0x0f)|((d>>22)&0x30)]; - - /* table contained 0213 4657 */ - *(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff; - s= ((s>>16)|(t&0xffff0000)); - - s=(s<<4)|(s>>28); - *(k++)=s&0xffffffff; - } -} diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/des.h b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/des.h deleted file mode 100644 index bb6ad3c..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/des.h +++ /dev/null @@ -1,7 +0,0 @@ -typedef unsigned char des_user_key[8]; -typedef unsigned char des_cblock[8]; -typedef unsigned long des_ks[32]; - -void des_crypt( des_cblock in, des_cblock out, des_ks key, int encrypt ); -void des_expand_key( des_user_key userKey, des_ks key ); - diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/test.pl b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/test.pl deleted file mode 100644 index cb4b2bd..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/test.pl +++ /dev/null @@ -1,370 +0,0 @@ -BEGIN { push @INC, qw(. .. ../lib ../../lib ../../../lib) } - -# -# Extended testing is Copyright (C) 2000 W3Works, LLC -# All rights reserved. -# -# -# Copyright (C) 1995, 1996 Systemics Ltd (http://www.systemics.com/) -# All rights reserved. -# - -package Crypt::DES; - -require Exporter; -require DynaLoader; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); - -@ISA = (Exporter, DynaLoader); - -# Items to export into callers namespace by default -@EXPORT = qw(); - -# Other items we are prepared to export if requested -@EXPORT_OK = qw(); - -$VERSION = '2.03'; -bootstrap Crypt::DES; - -use strict; -use Carp; - -sub usage -{ - my ($package, $filename, $line, $subr) = caller(1); - $Carp::CarpLevel = 2; - croak "Usage: $subr(@_)"; -} - -sub blocksize { 8; } -sub keysize { 8; } - -sub new -{ - usage("new DES key") unless @_ == 2; - my($type,$key) = @_; - - my $self = {}; - bless $self, $type; - - $self->{'ks'} = Crypt::DES::expand_key($key); - - return $self; -} - -sub encrypt -{ - usage("encrypt data[8 bytes]") unless @_ == 2; - - my ($self,$data) = @_; - return Crypt::DES::crypt($data, $data, $self->{'ks'}, 1); -} - -sub decrypt -{ - usage("decrypt data[8 bytes]") unless @_ == 2; - - my ($self,$data) = @_; - return Crypt::DES::crypt($data, $data, $self->{'ks'}, 0); -} - - - - -package main; - -use Data::Dumper; -use Benchmark; - -# -# Adding the above tests into this program is -# left as an exercise for the reader -# - -# -# Some test values... -# -# KEY PLAINTEXT CIPHERTEXT -my $testval = [ - ['0101010101010101', '95f8a5e5dd31d900', '8000000000000000'], - ['0101010101010101', 'dd7f121ca5015619', '4000000000000000'], - ['0101010101010101', '2e8653104f3834ea', '2000000000000000'], - ['0101010101010101', '4bd388ff6cd81d4f', '1000000000000000'], - ['0101010101010101', '20b9e767b2fb1456', '0800000000000000'], - ['0101010101010101', '55579380d77138ef', '0400000000000000'], - ['0101010101010101', '6cc5defaaf04512f', '0200000000000000'], - ['0101010101010101', '0d9f279ba5d87260', '0100000000000000'], - ['0101010101010101', 'd9031b0271bd5a0a', '0080000000000000'], - ['0101010101010101', '424250b37c3dd951', '0040000000000000'], - ['0101010101010101', 'b8061b7ecd9a21e5', '0020000000000000'], - ['0101010101010101', 'f15d0f286b65bd28', '0010000000000000'], - ['0101010101010101', 'add0cc8d6e5deba1', '0008000000000000'], - ['0101010101010101', 'e6d5f82752ad63d1', '0004000000000000'], - ['0101010101010101', 'ecbfe3bd3f591a5e', '0002000000000000'], - ['0101010101010101', 'f356834379d165cd', '0001000000000000'], - ['0101010101010101', '2b9f982f20037fa9', '0000800000000000'], - ['0101010101010101', '889de068a16f0be6', '0000400000000000'], - ['0101010101010101', 'e19e275d846a1298', '0000200000000000'], - ['0101010101010101', '329a8ed523d71aec', '0000100000000000'], - ['0101010101010101', 'e7fce22557d23c97', '0000080000000000'], - ['0101010101010101', '12a9f5817ff2d65d', '0000040000000000'], - ['0101010101010101', 'a484c3ad38dc9c19', '0000020000000000'], - ['0101010101010101', 'fbe00a8a1ef8ad72', '0000010000000000'], - ['0101010101010101', '750d079407521363', '0000008000000000'], - ['0101010101010101', '64feed9c724c2faf', '0000004000000000'], - ['0101010101010101', 'f02b263b328e2b60', '0000002000000000'], - ['0101010101010101', '9d64555a9a10b852', '0000001000000000'], - ['0101010101010101', 'd106ff0bed5255d7', '0000000800000000'], - ['0101010101010101', 'e1652c6b138c64a5', '0000000400000000'], - ['0101010101010101', 'e428581186ec8f46', '0000000200000000'], - ['0101010101010101', 'aeb5f5ede22d1a36', '0000000100000000'], - ['0101010101010101', 'e943d7568aec0c5c', '0000000080000000'], - ['0101010101010101', 'df98c8276f54b04b', '0000000040000000'], - ['0101010101010101', 'b160e4680f6c696f', '0000000020000000'], - ['0101010101010101', 'fa0752b07d9c4ab8', '0000000010000000'], - ['0101010101010101', 'ca3a2b036dbc8502', '0000000008000000'], - ['0101010101010101', '5e0905517bb59bcf', '0000000004000000'], - ['0101010101010101', '814eeb3b91d90726', '0000000002000000'], - ['0101010101010101', '4d49db1532919c9f', '0000000001000000'], - ['0101010101010101', '25eb5fc3f8cf0621', '0000000000800000'], - ['0101010101010101', 'ab6a20c0620d1c6f', '0000000000400000'], - ['0101010101010101', '79e90dbc98f92cca', '0000000000200000'], - ['0101010101010101', '866ecedd8072bb0e', '0000000000100000'], - ['0101010101010101', '8b54536f2f3e64a8', '0000000000080000'], - ['0101010101010101', 'ea51d3975595b86b', '0000000000040000'], - ['0101010101010101', 'caffc6ac4542de31', '0000000000020000'], - ['0101010101010101', '8dd45a2ddf90796c', '0000000000010000'], - ['0101010101010101', '1029d55e880ec2d0', '0000000000008000'], - ['0101010101010101', '5d86cb23639dbea9', '0000000000004000'], - ['0101010101010101', '1d1ca853ae7c0c5f', '0000000000002000'], - ['0101010101010101', 'ce332329248f3228', '0000000000001000'], - ['0101010101010101', '8405d1abe24fb942', '0000000000000800'], - ['0101010101010101', 'e643d78090ca4207', '0000000000000400'], - ['0101010101010101', '48221b9937748a23', '0000000000000200'], - ['0101010101010101', 'dd7c0bbd61fafd54', '0000000000000100'], - ['0101010101010101', '2fbc291a570db5c4', '0000000000000080'], - ['0101010101010101', 'e07c30d7e4e26e12', '0000000000000040'], - ['0101010101010101', '0953e2258e8e90a1', '0000000000000020'], - ['0101010101010101', '5b711bc4ceebf2ee', '0000000000000010'], - ['0101010101010101', 'cc083f1e6d9e85f6', '0000000000000008'], - ['0101010101010101', 'd2fd8867d50d2dfe', '0000000000000004'], - ['0101010101010101', '06e7ea22ce92708f', '0000000000000002'], - ['0101010101010101', '166b40b44aba4bd6', '0000000000000001'], - ['8001010101010101', '0000000000000000', '95a8d72813daa94d'], - ['4001010101010101', '0000000000000000', '0eec1487dd8c26d5'], - ['2001010101010101', '0000000000000000', '7ad16ffb79c45926'], - ['1001010101010101', '0000000000000000', 'd3746294ca6a6cf3'], - ['0801010101010101', '0000000000000000', '809f5f873c1fd761'], - ['0401010101010101', '0000000000000000', 'c02faffec989d1fc'], - ['0201010101010101', '0000000000000000', '4615aa1d33e72f10'], - ['0180010101010101', '0000000000000000', '2055123350c00858'], - ['0140010101010101', '0000000000000000', 'df3b99d6577397c8'], - ['0120010101010101', '0000000000000000', '31fe17369b5288c9'], - ['0110010101010101', '0000000000000000', 'dfdd3cc64dae1642'], - ['0108010101010101', '0000000000000000', '178c83ce2b399d94'], - ['0104010101010101', '0000000000000000', '50f636324a9b7f80'], - ['0102010101010101', '0000000000000000', 'a8468ee3bc18f06d'], - ['0101800101010101', '0000000000000000', 'a2dc9e92fd3cde92'], - ['0101400101010101', '0000000000000000', 'cac09f797d031287'], - ['0101200101010101', '0000000000000000', '90ba680b22aeb525'], - ['0101100101010101', '0000000000000000', 'ce7a24f350e280b6'], - ['0101080101010101', '0000000000000000', '882bff0aa01a0b87'], - ['0101040101010101', '0000000000000000', '25610288924511c2'], - ['0101020101010101', '0000000000000000', 'c71516c29c75d170'], - ['0101018001010101', '0000000000000000', '5199c29a52c9f059'], - ['0101014001010101', '0000000000000000', 'c22f0a294a71f29f'], - ['0101012001010101', '0000000000000000', 'ee371483714c02ea'], - ['0101011001010101', '0000000000000000', 'a81fbd448f9e522f'], - ['0101010801010101', '0000000000000000', '4f644c92e192dfed'], - ['0101010401010101', '0000000000000000', '1afa9a66a6df92ae'], - ['0101010201010101', '0000000000000000', 'b3c1cc715cb879d8'], - ['0101010180010101', '0000000000000000', '19d032e64ab0bd8b'], - ['0101010140010101', '0000000000000000', '3cfaa7a7dc8720dc'], - ['0101010120010101', '0000000000000000', 'b7265f7f447ac6f3'], - ['0101010110010101', '0000000000000000', '9db73b3c0d163f54'], - ['0101010108010101', '0000000000000000', '8181b65babf4a975'], - ['0101010104010101', '0000000000000000', '93c9b64042eaa240'], - ['0101010102010101', '0000000000000000', '5570530829705592'], - ['0101010101800101', '0000000000000000', '8638809e878787a0'], - ['0101010101400101', '0000000000000000', '41b9a79af79ac208'], - ['0101010101200101', '0000000000000000', '7a9be42f2009a892'], - ['0101010101100101', '0000000000000000', '29038d56ba6d2745'], - ['0101010101080101', '0000000000000000', '5495c6abf1e5df51'], - ['0101010101040101', '0000000000000000', 'ae13dbd561488933'], - ['0101010101020101', '0000000000000000', '024d1ffa8904e389'], - ['0101010101018001', '0000000000000000', 'd1399712f99bf02e'], - ['0101010101014001', '0000000000000000', '14c1d7c1cffec79e'], - ['0101010101012001', '0000000000000000', '1de5279dae3bed6f'], - ['0101010101011001', '0000000000000000', 'e941a33f85501303'], - ['0101010101010801', '0000000000000000', 'da99dbbc9a03f379'], - ['0101010101010401', '0000000000000000', 'b7fc92f91d8e92e9'], - ['0101010101010201', '0000000000000000', 'ae8e5caa3ca04e85'], - ['0101010101010180', '0000000000000000', '9cc62df43b6eed74'], - ['0101010101010140', '0000000000000000', 'd863dbb5c59a91a0'], - ['0101010101010120', '0000000000000000', 'a1ab2190545b91d7'], - ['0101010101010110', '0000000000000000', '0875041e64c570f7'], - ['0101010101010108', '0000000000000000', '5a594528bebef1cc'], - ['0101010101010104', '0000000000000000', 'fcdb3291de21f0c0'], - ['0101010101010102', '0000000000000000', '869efd7f9f265a09'], - ['1046913489980131', '0000000000000000', '88d55e54f54c97b4'], - ['1007103489988020', '0000000000000000', '0c0cc00c83ea48fd'], - ['10071034c8980120', '0000000000000000', '83bc8ef3a6570183'], - ['1046103489988020', '0000000000000000', 'df725dcad94ea2e9'], - ['1086911519190101', '0000000000000000', 'e652b53b550be8b0'], - ['1086911519580101', '0000000000000000', 'af527120c485cbb0'], - ['5107b01519580101', '0000000000000000', '0f04ce393db926d5'], - ['1007b01519190101', '0000000000000000', 'c9f00ffc74079067'], - ['3107915498080101', '0000000000000000', '7cfd82a593252b4e'], - ['3107919498080101', '0000000000000000', 'cb49a2f9e91363e3'], - ['10079115b9080140', '0000000000000000', '00b588be70d23f56'], - ['3107911598090140', '0000000000000000', '406a9a6ab43399ae'], - ['1007d01589980101', '0000000000000000', '6cb773611dca9ada'], - ['9107911589980101', '0000000000000000', '67fd21c17dbb5d70'], - ['9107d01589190101', '0000000000000000', '9592cb4110430787'], - ['1007d01598980120', '0000000000000000', 'a6b7ff68a318ddd3'], - ['1007940498190101', '0000000000000000', '4d102196c914ca16'], - ['0107910491190401', '0000000000000000', '2dfa9f4573594965'], - ['0107910491190101', '0000000000000000', 'b46604816c0e0774'], - ['0107940491190401', '0000000000000000', '6e7e6221a4f34e87'], - ['19079210981a0101', '0000000000000000', 'aa85e74643233199'], - ['1007911998190801', '0000000000000000', '2e5a19db4d1962d6'], - ['10079119981a0801', '0000000000000000', '23a866a809d30894'], - ['1007921098190101', '0000000000000000', 'd812d961f017d320'], - ['100791159819010b', '0000000000000000', '055605816e58608f'], - ['1004801598190101', '0000000000000000', 'abd88e8b1b7716f1'], - ['1004801598190102', '0000000000000000', '537ac95be69da1e1'], - ['1004801598190108', '0000000000000000', 'aed0f6ae3c25cdd8'], - ['1002911598100104', '0000000000000000', 'b3e35a5ee53e7b8d'], - ['1002911598190104', '0000000000000000', '61c79c71921a2ef8'], - ['1002911598100201', '0000000000000000', 'e2f5728f0995013c'], - ['1002911698100101', '0000000000000000', '1aeac39a61f0a464'], - ['7ca110454a1a6e57', '01a1d6d039776742', '690f5b0d9a26939b'], - ['0131d9619dc1376e', '5cd54ca83def57da', '7a389d10354bd271'], - ['07a1133e4a0b2686', '0248d43806f67172', '868ebb51cab4599a'], - ['3849674c2602319e', '51454b582ddf440a', '7178876e01f19b2a'], - ['04b915ba43feb5b6', '42fd443059577fa2', 'af37fb421f8c4095'], - ['0113b970fd34f2ce', '059b5e0851cf143a', '86a560f10ec6d85b'], - ['0170f175468fb5e6', '0756d8e0774761d2', '0cd3da020021dc09'], - ['43297fad38e373fe', '762514b829bf486a', 'ea676b2cb7db2b7a'], - ['07a7137045da2a16', '3bdd119049372802', 'dfd64a815caf1a0f'], - ['04689104c2fd3b2f', '26955f6835af609a', '5c513c9c4886c088'], - ['37d06bb516cb7546', '164d5e404f275232', '0a2aeeae3ff4ab77'], - ['1f08260d1ac2465e', '6b056e18759f5cca', 'ef1bf03e5dfa575a'], - ['584023641aba6176', '004bd6ef09176062', '88bf0db6d70dee56'], - ['025816164629b007', '480d39006ee762f2', 'a1f9915541020b56'], - ['49793ebc79b3258f', '437540c8698f3cfa', '6fbf1cafcffd0556'], - ['4fb05e1515ab73a7', '072d43a077075292', '2f22e49bab7ca1ac'], - ['49e95d6d4ca229bf', '02fe55778117f12a', '5a6b612cc26cce4a'], - ['018310dc409b26d6', '1d9d5c5018f728c2', '5f4c038ed12b2e41'], - ['1c587f1c13924fef', '305532286d6f295a', '63fac0d034d9f793'], - ]; - -my $i = 1; -my $fail = 0; -my $tt = (scalar(@{$testval}) *2); -print "1..$tt\n"; -my $t0 = new Benchmark; -foreach my $tst (@{$testval}) { - my ($anot,$bnot) = (0,0); - foreach(@{$tst}) { $_ = pack("H*",$_) } - - my $cipher = new Crypt::DES($tst->[0]); - $anot = 1 unless ($cipher->encrypt($tst->[1]) eq $tst->[2]); - if($anot) { - #print "not "; - $fail++; - } - $i++; - - $bnot = 1 unless ($cipher->decrypt($tst->[2]) eq $tst->[1]); - if($bnot) { - #print "not "; - $fail++; - } -; - $i++; -} -my $t1 = new Benchmark; - -my $suc = $tt - $fail; -my $fp = sprintf("%0.2f",(($tt / $suc) * 100)) unless $suc == 0; -if($suc == 0) { $fp = '0.00' } -my $td0 = timediff($t1,$t0); -my $ts0 = timestr($td0); -print "$tt basic tests ran in $ts0\n"; -print "$suc of $tt tests passed ($fp\%)\n"; -if($fail > 0) { - print "Not all tests successful. Please attempt to rebuild the package\n"; -} else { - print "\nRunning speed tests...\n"; - print "\nnon-cached cipher speed test. 5000 encrypt iterations\n"; - my $t2 = new Benchmark; - for(1..5000) { - my $cipher = new Crypt::DES(pack("H*",'1c587f1c13924fef')); - $cipher->encrypt(pack("H*",'305532286d6f295a')); - } - my $t3 = new Benchmark; - my $td1 = timediff($t3,$t2); - my $ts1 = timestr($td1); - print "$ts1\nok 343\n"; - - print "\nnon-cached cipher speed test. 5000 decrypt iterations\n"; - my $t4 = new Benchmark; - for(1..5000) { - my $cipher = new Crypt::DES(pack("H*",'1c587f1c13924fef')); - $cipher->decrypt(pack("H*",'63fac0d034d9f793')); - } - my $t5 = new Benchmark; - my $td2 = timediff($t5,$t4); - my $ts2 = timestr($td2); - print "$ts2\nok 344\n"; - - print "\ncached cipher speed test. 10000 encrypt iterations\n"; - { - my $t6 = new Benchmark; - my $cipher = new Crypt::DES(pack("H*",'1c587f1c13924fef')); - for(1..10000) { - $cipher->encrypt(pack("H*",'305532286d6f295a')); - } - my $t7 = new Benchmark; - my $td3 = timediff($t7,$t6); - my $ts3 = timestr($td3); - print "$ts3\nok 345\n"; - } - - print "\ncached cipher speed test. 10000 decrypt iterations\n"; - { - my $t8 = new Benchmark; - my $cipher = new Crypt::DES(pack("H*",'1c587f1c13924fef')); - for(1..10000) { - $cipher->decrypt(pack("H*",'63fac0d034d9f793')); - } - my $t9 = new Benchmark; - my $td4 = timediff($t9,$t8); - my $ts4 = timestr($td4); - print "$ts4\nok 346\n"; - } -} - -print "\nTesting Cipher Block Chaining..\n"; -eval 'use Crypt::CBC'; - -if(!$@) { - if($Crypt::CBC::VERSION < 1.22) { - $@ = "CBC mode requires Crypt::CBC version 1.22 or higher."; - } else { - - my $cipher = new Crypt::CBC(pack("H*","0123456789ABCDEF"),"DES"); - my $ciphertext = $cipher->encrypt(pack("H*","37363534333231204E6F77206973207468652074696D6520666F722000")); - my $plaintext = $cipher->decrypt($ciphertext); - - if($plaintext ne "7654321 Now is the time for \0") { print "not "; } - print "ok 347 - CBC Mode\n"; - } -} # end no errors - -if($@) { - print "Error (probably harmless):\n$@\n"; -} - -print "\nFinished with tests\n\n"; diff --git a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/typemap b/monitoring/PerlModules/CPAN/Crypt-DES-2.03/typemap deleted file mode 100644 index 02522e8..0000000 --- a/monitoring/PerlModules/CPAN/Crypt-DES-2.03/typemap +++ /dev/null @@ -1 +0,0 @@ -TYPEMAP diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/BUILD b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/BUILD deleted file mode 100644 index e28839a..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/BUILD +++ /dev/null @@ -1,47 +0,0 @@ -# Macros - -#control upversion -%define external_package 1 - -%define cvs_package PerlModules/CPAN/DBD-Pg-0.95 - - -# Package specific stuff -Name: DBD-Pg -Version: 1.1.0 -Release: 2 -Packager: Dave Parker <dparker(a)nocpulse.com> -Summary: Perl DBD-Pg library (postgresql) -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: i386 -Requires: perl -Group: unsorted -License: GPL or Artistic -Vendor: Red Hat, Inc. -BuildRoot: %{_tmppath}/%cvs_package -Prefix: %{_our_prefix} - -%description - -Provides DBD-Pg library - - - -%prep -%entirely_abstract_build_step - -%build -export POSTGRES_INCLUDE="/usr/include/pgsql/" -export POSTGRES_LIB="/usr/lib/pgsql/" -%makefile_build - -%install -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - -%files -f %{name}-%{version}-%{release}-filelist - -%clean -%abstract_clean_script diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Changes b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Changes deleted file mode 100644 index b9ac365..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Changes +++ /dev/null @@ -1,238 +0,0 @@ -Revision history for Perl extension DBD-Pg. - -0.95 Jul 10, 2000 - - add Win32 port from Bob Kline <bkline(a)rksystems.com>. - -0.94 Jul 07, 2000 - - applied patch from Rudy Lippan <almighty(a)randomc.com> - which fixes a memory-leak with failed connections. - - applied patch from Hein Roehrig <hein(a)acm.org> - which fixes a bug with escaping a backslash except for - octal presentation - - applied patch from Francis J. Lacoste <francis.lacoste(a)iNsu.COM - which fixes a segmentation fault when all binded parameters are NULL - - adapt test.pl to avoid warnings with postgresql-7.0 - - added support for 'COPY FROM STDIN' and 'COPY TO STDOUT' - - added patch from Mark Stosberg <mark(a)summersault.com> - to enhance the table_attributes subroutine - -0.93 Sep 29, 1999 - - it is required now to set the environment variables POSTGRES_INCLUDE - and POSTGRES_LIB for compiling the module. - - add Win32 port from Bob Kline <bkline(a)rksystems.com>. - - support for all large-object functions via the func - interface. - - fixed bug with placeholders and casts spotted by - mschout(a)gkg.net - - replaced the method attributes by the method table_attributes, - from Scott Williams <scott(a)james.com>. - - fix type definitions for type_info_all(). - bug spotted by "carlos" <emarcet(a)intramed.net.ar>. - - now the Pg-specific quote() method also evaluates the - data-type paramater. - -0.92 Jun 16, 1999 - - proposal from Philip Warner <pjw(a)rhyme.com.au>: - increase BUFSIZE from 1024 to 32768 in order to improve - I/O performance. - - bug-fix in Makefile.PL for $POSTGRES_HOME not defined - spotted by mdalphin(a)amgen.com (Mark Dalphin) - - bug-fix for data-type datetime in type_info_all - spotted by Alan Grover <awgrover(a)iconnect-inc.com> - - bug-fix for escaped 's spotted by Hankin <hankin(a)consultco.com> - - removed 'large objects' related tests from test.pl - -0.91 Feb 14, 1999 - - removed restriction for commercial use in copyright - - corrected DATA_TYPE in type_info_all() - -0.90 Jan 15, 1998 - - discard parameter authtype from connect string - - remove work-around for bug in the large object - interface of postgresql - -0.89 Nov 05, 1998 - - bug-fix from Jan Iven <j.iven(a)rz.uni-sb.de>: - fix problem with quoting Null in bind variables. - -0.88 Oct 10, 1998 - - fixed blob_read - - suppressed warning when testing DBI::errstr - -0.87 Sep 05, 1998 - - Pg.xs adapted to Driver.xst from DBI-1.0 - - major rewrite of module documentation - - major rewrite of the test script - - use built-in DBI method for $dbh->do - - add macro dHTR in order to avoid compile errors - with threaded perl5.005 - - renamed attribute AutoEscape to pg_auto_escape - - renamed attribute SIZE to pg_size - - new attribute pg_type - - added support for DBI->data_sources($driver) - - added support for $dbh->table_info - - blob_read documented and added to test.pl - - added support for attr parameter in bind_param() - -0.86 Aug 21, 1998 - - added /usr/lib/ to search path for libpq. - - added ChopBlanks, patch from - Victor Krasinsky <victor(a)rdovira.lviv.ua> - - changed test.pl to test multiple database handles - -0.85 July 19, 1998 - - non-printable characters in parameters will not be - converted to '.'. They are passed unchanged to the - database. - -0.84 July 18, 1998 - - bug-fix from Max Cohan <mcohan(a)adnc.net>: - check for \xxx presentation before escaping backslash - in parameters. - - introduce new database handle attribute AutoEscape, which - controls escaping of quotes and backslashes in parameters. - When set to on, all quotes except at the beginning and - at the end of a line will be escaped and all backslashes - except when used to indicate an octal presentation (\xxx) - will be escaped. Default of AutoEscape is on. - -0.83 July 10, 1998 - - bug-fix from Max Cohan <mcohan(a)adnc.net>: - using traces together with undef in place-holders dumped - core. - -0.82 June 20, 1998 - - bug-fix from Matthew Lenz <matthew(a)nocturnal.org>: - corrected include path in Makefile.PL . - - added 'use strict;' to test.pl - -0.81 June 13, 1998 - - bug-fix from Rolf Grossmann <grossman(a)securitas.net>: - undefined parameters in an execute statement will be - translated from 'undef' to 'NULL'. Also every parameter - for bind_param() will be quoted by default (escape quote - and backslash). Appropriate tests have been added to test.pl. - - change ping method to use libpq-interface. - -0.80 June 07, 1998 - - adapted to postgresql-6.4: - the backend protocol has changed, which needs an adapted - ping method. A ping-test has been added to the test-script. - Also some type identifiers have changed. - -0.73 June 03, 1998 - - changed include directives in Makefile.PL from - archlib to installarchlib and from sitearch to - installsitearch (Tony.Curtis(a)vcpc.univie.ac.at) - - applied patch from Junio Hamano <junio(a)twinsun.com> - quote method also doubles backslash. - -0.72 April 20, 1998 - - applied patch from Michael J Schout <mschout(a)gkg.net> - which fixed the bug with queries containing the cast - operator. - - applied patch from "Irving Reid" <irving(a)tor.securecomputing.com> - which fixed a memory leak. - -0.71 April 04, 1998 - - applied patch from "Irving Reid" - <irving(a)tor.securecomputing.com> which fixed the - the problem with the InactiveDestroy message. - -0.70 March 28, 1998 - - linking again with the shared version of libpq - due to problems on several operating systems. - -0.69 March 6, 1998 - - expanded the search path for include files - - module is now linked with static libpq.a - -0.68 March 3, 1998 - - return to UNIX domain sockets in test-scripts - -0.67 February 21, 1998 - - remove part of Driver.xst due to compile - error on some systems. - -0.66 February 19, 1998 - - remove defines in Pg.h so that - it compiles also with postgresql-6.2.1 - - changed ping method: set RaiseError=0 - -0.65 February 14, 1998 - - adapted to changes in DBI-0.91, so that the - default setting for AutoCommit and PrintError is - again conformant to the DBI specs. - -0.64 February 01, 1998 - - changed syntax of data_source (ODBC-conformant): - 'dbi:Pg:dbname=dbname;host=host;port=port' - !!! PLEASE ADAPT YOUR SCRIPTS !!! - - implemented place-holders - - implemented ping-method - - added support for $dbh->{RaiseError} and $dbh->{PrintError}, - note: DBI-default for PrintError is on ! - - allow commit and rollback only if AutoCommit = off - - added documentation for $dbh->tables; - - new method to get meta-information about a given table: - $dbh->DBD::Pg::db::attributes($table); - - host-parameter in test.pl is set explicitly to localhost - -0.63 October 05, 1997 - - adapted to PostgreSQL-6.2: - o $sth->rows as well as $sth->execute - and $sth->do return the number of - affected rows even for non-Select - statements. - o support for password authorization added, - please check the man-page for pg_passwd. - - the data_source parameter of the connect - method accepts two additional parameters - which are treated as host and port: - DBI->connect("dbi:Pg:dbname:host:port", "uid", "pwd") - - support for AutoCommit, please read the - module documentation for impacts on your - scripts ! - - more perl-ish handling of data type bool, - please read the module documentation for - impacts on your scripts ! - -0.62 August 26, 1997 - - added blobs/README - -0.61 August 23, 1997 - - adapted to DBI-0.89/Driver.xst - - added support for blob_read - -0.52 August 15, 1997 - - added support for literal $sth->{'TYPE'}, - pg_type.pl / pg_type.pm. - -0.51 August 12, 1997 - - changed attributes to be DBI conformant: - o OID_STATUS to pg_oid_status - o CMD_STATUS to pg_cmd_status - -0.5 August 05, 1997 - - support for user authentication - - support for bind_columns - - added $dbh->tables - -0.4 Jun 24, 1997 - - adapted to DBI-0.84: - o new syntax for DBI->connect ! - o execute returns 0E0 -> n for SELECT stmt - -1 for non SELECT stmt - -2 on error - - new attribute $sth->{'OID_STATUS'} - - new attribute $sth->{'CMD_STATUS'} - -0.3 Apr 24, 1997 - - bug fix release, ( still alpha ! ) - -0.2 Mar 13, 1997 - - complete rewrite, ( still alpha ! ) - -0.1 Feb 15, 1997 - - creation, ( totally pre-alpha ! ) - diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/MANIFEST b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/MANIFEST deleted file mode 100644 index d035279..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/MANIFEST +++ /dev/null @@ -1,13 +0,0 @@ -Changes -MANIFEST -Makefile.PL -Pg.h -Pg.pm -Pg.xs -README -README.win32 -dbd-pg.pod -dbdimp.c -dbdimp.h -eg/ApacheDBI.pl -test.pl diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Makefile.PL b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Makefile.PL deleted file mode 100644 index 5b37df8..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Makefile.PL +++ /dev/null @@ -1,63 +0,0 @@ - -# $Id: Makefile.PL,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - -use ExtUtils::MakeMaker; -use Config; -use strict; -use DBI 1.00; -use DBI::DBD; - -print "Configuring Pg\n"; -print "Remember to actually read the README file !\n"; - -my $POSTGRES_INCLUDE; -my $POSTGRES_LIB; - -if ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and !$ENV{POSTGRES_HOME}) { - die "please set environment variables POSTGRES_INCLUDE and POSTGRES_LIB !\n"; -} elsif ((!$ENV{POSTGRES_INCLUDE} or !$ENV{POSTGRES_LIB}) and $ENV{POSTGRES_HOME}) { - $POSTGRES_INCLUDE = "$ENV{POSTGRES_HOME}/include"; - $POSTGRES_LIB = "$ENV{POSTGRES_HOME}/lib"; -} else { - $POSTGRES_INCLUDE = "$ENV{POSTGRES_INCLUDE}"; - $POSTGRES_LIB = "$ENV{POSTGRES_LIB}"; -} - -my $os = $^O; -print "OS: $os\n"; - -my $dbi_arch_dir; -if ($os eq 'MSWin32') { - $dbi_arch_dir = "\$(INSTALLSITEARCH)/auto/DBI"; -} else { - $dbi_arch_dir = dbd_dbi_arch_dir(); -} - -my %opts = ( - NAME => 'DBD::Pg', - VERSION_FROM => 'Pg.pm', - INC => "-I$POSTGRES_INCLUDE -I$dbi_arch_dir", - OBJECT => "Pg\$(OBJ_EXT) dbdimp\$(OBJ_EXT)", - LIBS => ["-L$POSTGRES_LIB -lpq"], - AUTHOR => 'Edmund Mergl (E.Mergl(a)bawue.de)', - ABSTRACT => 'PostgreSQL database driver for the DBI module', -); - -if ($os eq 'hpux') { - my $osvers = $Config{osvers}; - if ($osvers < 10) { - print "Warning: Forced to build static not dynamic on $os $osvers.\a\n"; - $opts{LINKTYPE} = 'static'; - } -} - -if ($Config{dlsrc} =~ /dl_none/) { - $opts{LINKTYPE} = 'static'; -} - - -WriteMakefile(%opts); - -exit(0); - -# end of Makefile.PL diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.h b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.h deleted file mode 100644 index 3d573a9..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.h +++ /dev/null @@ -1,46 +0,0 @@ -/* - $Id: Pg.h,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - Copyright (c) 1997,1998,1999,2000 Edmund Mergl - Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. - -*/ - - -#ifdef WIN32 -static int errno; -#endif - -#include "libpq-fe.h" - -#ifdef NEVER -#include<sys/stat.h> -#include "libpq/libpq-fs.h" -#endif -#ifndef INV_READ -#define INV_READ 0x00040000 -#endif -#ifndef INV_WRITE -#define INV_WRITE 0x00020000 -#endif - -#ifdef BUFSIZ -#undef BUFSIZ -#endif -/* this should improve I/O performance for large objects */ -#define BUFSIZ 32768 - - -#define NEED_DBIXS_VERSION 93 - -#include <DBIXS.h> /* installed by the DBI module */ - -#include "dbdimp.h" /* read in our implementation details */ - -#include <dbd_xsh.h> /* installed by the DBI module */ - - -/* end of Pg.h */ diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.pm b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.pm deleted file mode 100644 index cb5bbad..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.pm +++ /dev/null @@ -1,1162 +0,0 @@ - -# $Id: Pg.pm,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ -# -# Copyright (c) 1997,1998,1999,2000 Edmund Mergl -# Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce -# -# You may distribute under the terms of either the GNU General Public -# License or the Artistic License, as specified in the Perl README file. - - -require 5.003; - -$DBD::Pg::VERSION = '0.95'; - -{ - package DBD::Pg; - - use DBI (); - use DynaLoader (); - use Exporter (); - @ISA = qw(DynaLoader Exporter); - - require_version DBI 1.00; - - bootstrap DBD::Pg $VERSION; - - $err = 0; # holds error code for DBI::err - $errstr = ""; # holds error string for DBI::errstr - $drh = undef; # holds driver handle once initialized - - sub driver{ - return $drh if $drh; - my($class, $attr) = @_; - - $class .= "::dr"; - - # not a 'my' since we use it above to prevent multiple drivers - - $drh = DBI::_new_drh($class, { - 'Name' => 'Pg', - 'Version' => $VERSION, - 'Err' => \$DBD::Pg::err, - 'Errstr' => \$DBD::Pg::errstr, - 'Attribution' => 'PostgreSQL DBD by Edmund Mergl', - }); - - $drh; - } - - 1; -} - - -{ package DBD::Pg::dr; # ====== DRIVER ====== - use strict; - - sub data_sources { - my $drh = shift; - my $dbh = DBD::Pg::dr::connect($drh, 'dbname=template1') or return undef; - $dbh->{AutoCommit} = 1; - my $sth = $dbh->prepare("SELECT datname FROM pg_database ORDER BY datname") or return undef; - $sth->execute or return undef; - my (@sources, @datname); - while (@datname = $sth->fetchrow_array) { - push @sources, "dbi:Pg:dbname=$datname[0]"; - } - $sth->finish; - $dbh->disconnect; - return @sources; - } - - - sub connect { - my($drh, $dbname, $user, $auth)= @_; - - # create a 'blank' dbh - - my $Name = $dbname; - $Name =~ s/^.*dbname\s*=\s*//; - $Name =~ s/\s*;.*$//; - - $user = '' unless defined($user); - $auth = '' unless defined($auth); - - $user = $ENV{DBI_USER} unless defined($user); - $auth = $ENV{DBI_PASS} unless defined($auth); - - my($dbh) = DBI::_new_dbh($drh, { - 'Name' => $Name, - 'User' => $user, 'CURRENT_USER' => $user, - }); - - # Connect to the database.. - DBD::Pg::db::_login($dbh, $dbname, $user, $auth) or return undef; - - $dbh; - } - -} - - -{ package DBD::Pg::db; # ====== DATABASE ====== - use strict; - - sub prepare { - my($dbh, $statement, @attribs)= @_; - - # create a 'blank' sth - - my $sth = DBI::_new_sth($dbh, { - 'Statement' => $statement, - }); - - DBD::Pg::st::_prepare($sth, $statement, @attribs) or return undef; - - $sth; - } - - - sub ping { - my($dbh) = @_; - - local $SIG{__WARN__} = sub { } if $dbh->{PrintError}; - local $dbh->{RaiseError} = 0 if $dbh->{RaiseError}; - my $ret = DBD::Pg::db::_ping($dbh); - - return $ret; - } - - - sub table_info { # DBI spec: TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TABLE_TYPE, REMARKS - my($dbh) = @_; - - my $sth = $dbh->prepare(" - SELECT c.reltype, u.usename, c.relname, 'TABLE', '' - FROM pg_class c, pg_user u - WHERE c.relkind = 'r' - AND c.relhasrules = FALSE - AND c.relname !~ '^pg_' - AND c.relname !~ '^xin[vx][0-9]+' - AND c.relowner = u.usesysid - UNION - SELECT c.reltype, u.usename, c.relname, 'VIEW', '' - FROM pg_class c, pg_user u - WHERE c.relkind = 'r' - AND c.relhasrules = TRUE - AND c.relname !~ '^pg_' - AND c.relname !~ '^xin[vx][0-9]+' - AND c.relowner = u.usesysid - ORDER BY 1, 2, 3 - ") or return undef; - $sth->execute or return undef; - - $sth; - } - - - sub tables { - my($dbh) = @_; - - my $sth = $dbh->prepare(" - select relname - from pg_class - where relkind = 'r' - and relname !~ '^pg_' - and relname !~ '^xin[vx][0-9]+' - order by 1 - ") or return undef; - $sth->execute or return undef; - my (@tables, @relname); - while (@relname = $sth->fetchrow_array) { - push @tables, $relname[0]; - } - $sth->finish; - - return @tables; - } - - - sub table_attributes { - my ($dbh, $table) = @_; - my $result = []; - my $attrs = $dbh->selectall_arrayref( - "select a.attname, t.typname, a.attlen, a.atttypmod, a.attnotnull, a.atthasdef, a.attnum - from pg_attribute a, - pg_class c, - pg_type t - where c.relname = '$table' - and a.attrelid = c.oid - and a.attnum >= 0 - and t.oid = a.atttypid - order by 1 - "); - - return $result unless scalar(@$attrs); - - # Get the primary key - my ($pri_key) = $dbh->selectrow_array("SELECT pg_attribute.attname - FROM pg_class, pg_attribute, pg_index - WHERE pg_class.oid = pg_attribute.attrelid - AND pg_class.oid = pg_index.indrelid - AND pg_index.indkey[0] = pg_attribute.attnum - AND pg_index.indisprimary = 't' - AND pg_class.relname = '$table'"); - $pri_key = '' unless $pri_key; - - foreach my $attr (reverse @$attrs) { - my ($col_name, $col_type, $size, $mod, $notnull, $hasdef, $attnum) = @$attr; - my $col_size = do { - if ($size > 0) { - $size; - } elsif ($mod > 0xffff) { - my $prec = ($mod & 0xffff) - 4; - $mod >>= 16; - my $dig = $mod; - $dig; - } elsif ($mod >= 4) { - $mod - 4; - } else { - $mod; - } - }; - - # Get the default value, if any - my ($default) = $dbh->selectrow_array("SELECT adsrc FROM pg_attrdef WHERE adnum = $attnum") if -1 == $attnum; - $default = '' unless $default; - - # Test for any constraints - my ($constraint) = $dbh->selectrow_array("select rcsrc from pg_relcheck where rcname = '${table}_$col_name'"); - $constraint = '' unless $constraint; - - # Check to see if this is the primary key - my $is_primary_key; - ($pri_key eq $col_name) ? $is_primary_key = 1 : $is_primary_key = 0; - - push @$result, - { NAME => $col_name, - TYPE => $col_type, - SIZE => $col_size, - NOTNULL => $notnull, - DEFAULT => $default, - CONSTRAINT => $constraint, - PRIMARY_KEY => $is_primary_key, - }; - } - - return $result; - } - - - sub type_info_all { - my ($dbh) = @_; - my $names = { - TYPE_NAME => 0, - DATA_TYPE => 1, - PRECISION => 2, - LITERAL_PREFIX => 3, - LITERAL_SUFFIX => 4, - CREATE_PARAMS => 5, - NULLABLE => 6, - CASE_SENSITIVE => 7, - SEARCHABLE => 8, - UNSIGNED_ATTRIBUTE => 9, - MONEY =>10, - AUTO_INCREMENT =>11, - LOCAL_TYPE_NAME =>12, - MINIMUM_SCALE =>13, - MAXIMUM_SCALE =>14, - }; - - # typname |typlen|typprtlen| SQL92 - # --------------+------+---------+ ------- - # bool | 1| 1| BOOLEAN - # text | -1| -1| like VARCHAR, but automatic storage allocation - # bpchar | -1| -1| CHARACTER(n) bp=blank padded - # varchar | -1| -1| VARCHAR(n) - # int2 | 2| 5| SMALLINT - # int4 | 4| 10| INTEGER - # int8 | 8| 20| / - # money | 4| 24| / - # float4 | 4| 12| FLOAT(p) for p<7=float4, for p<16=float8 - # float8 | 8| 24| REAL - # abstime | 4| 20| / - # reltime | 4| 20| / - # tinterval | 12| 47| / - # date | 4| 10| / - # time | 8| 16| / - # datetime | 8| 47| / - # timespan | 12| 47| INTERVAL - # timestamp | 4| 19| TIMESTAMP - # --------------+------+---------+ - - # DBI type definitions / PostgreSQL definitions # type needs to be DBI-specific (not pg_type) - # - # SQL_ALL_TYPES 0 - # SQL_CHAR 1 1042 bpchar - # SQL_NUMERIC 2 700 float4 - # SQL_DECIMAL 3 700 float4 - # SQL_INTEGER 4 23 int4 - # SQL_SMALLINT 5 21 int2 - # SQL_FLOAT 6 700 float4 - # SQL_REAL 7 701 float8 - # SQL_DOUBLE 8 20 int8 - # SQL_DATE 9 1082 date - # SQL_TIME 10 1083 time - # SQL_TIMESTAMP 11 1296 timestamp - # SQL_VARCHAR 12 1043 varchar - - my $ti = [ - $names, - # name type prec prefix suffix create params null case se unsign mon incr local min max - # - [ 'bool', 0, 1, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'BOOLEAN', undef, undef ], - [ 'int8', 8, 20, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'LONGINT', undef, undef ], - [ 'int2', 5, 5, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'SMALLINT', undef, undef ], - [ 'int4', 4, 10, undef, undef, undef, 1, '0', 2, '0', '0', '0', 'INTEGER', undef, undef ], - [ 'text', 12, 4096, '\'', '\'', undef, 1, '1', 3, undef, '0', '0', 'TEXT', undef, undef ], - [ 'float4', 6, 12, undef, undef, 'precision', 1, '0', 2, '0', '0', '0', 'FLOAT', undef, undef ], - [ 'float8', 7, 24, undef, undef, 'precision', 1, '0', 2, '0', '0', '0', 'REAL', undef, undef ], - [ 'abstime', 10, 20, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'ABSTIME', undef, undef ], - [ 'reltime', 10, 20, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'RELTIME', undef, undef ], - [ 'tinterval', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TINTERVAL', undef, undef ], - [ 'money', 0, 24, undef, undef, undef, 1, '0', 2, undef, '1', '0', 'MONEY', undef, undef ], - [ 'bpchar', 12, 4096, '\'', '\'', 'max length', 1, '1', 3, undef, '0', '0', 'CHARACTER', undef, undef ], - [ 'varchar', 12, 4096, '\'', '\'', 'max length', 1, '1', 3, undef, '0', '0', 'VARCHAR', undef, undef ], - [ 'date', 9, 10, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'DATE', undef, undef ], - [ 'time', 10, 16, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TIME', undef, undef ], - [ 'datetime', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'DATETIME', undef, undef ], - [ 'timespan', 11, 47, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'INTERVAL', undef, undef ], - [ 'timestamp', 10, 19, '\'', '\'', undef, 1, '0', 2, undef, '0', '0', 'TIMESTAMP', undef, undef ] - # - # intentionally omitted: char, bytea, all geometric types, all array types - ]; - return $ti; - } - - - sub quote { - my ($dbh, $str, $data_type) = @_; - - return "NULL" unless defined $str; - - unless ($data_type) { - $str =~ s/'/''/g; # ISO SQL2 - # In addition to the DBI method it doubles also the - # backslash, because PostgreSQL treats a backslash as an - # escape character. - $str =~ s/\\/\\\\/g; - return "'$str'"; - } - - # Optimise for standard numerics which need no quotes - return $str if $data_type == DBI::SQL_INTEGER - || $data_type == DBI::SQL_SMALLINT - || $data_type == DBI::SQL_DECIMAL - || $data_type == DBI::SQL_FLOAT - || $data_type == DBI::SQL_REAL - || $data_type == DBI::SQL_DOUBLE - || $data_type == DBI::SQL_NUMERIC; - my $ti = $dbh->type_info($data_type); - # XXX needs checking - my $lp = $ti ? $ti->{LITERAL_PREFIX} || "" : "'"; - my $ls = $ti ? $ti->{LITERAL_SUFFIX} || "" : "'"; - # XXX don't know what the standard says about escaping - # in the 'general case' (where $lp != "'"). - # So we just do this and hope: - $str =~ s/$lp/$lp$lp/g - if $lp && $lp eq $ls && ($lp eq "'" || $lp eq '"'); - return "$lp$str$ls"; - } -} - - -{ package DBD::Pg::st; # ====== STATEMENT ====== - - # all done in XS - -} - -1; - -__END__ - - -=head1 NAME - -DBD::Pg - PostgreSQL database driver for the DBI module - - -=head1 SYNOPSIS - - use DBI; - - $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", ""); - - # See the DBI module documentation for full details - - -=head1 DESCRIPTION - -DBD::Pg is a Perl module which works with the DBI module to provide -access to PostgreSQL databases. - - -=head1 MODULE DOCUMENTATION - -This documentation describes driver specific behavior and restrictions. -It is not supposed to be used as the only reference for the user. In any -case consult the DBI documentation first ! - - -=head1 THE DBI CLASS - -=head2 DBI Class Methods - -=over 4 - -=item B<connect> - -To connect to a database with a minimum of parameters, use the -following syntax: - - $dbh = DBI->connect("dbi:Pg:dbname=$dbname", "", ""); - -This connects to the database $dbname at localhost without any user -authentication. This is sufficient for the defaults of PostgreSQL. - -The following connect statement shows all possible parameters: - - $dbh = DBI->connect("dbi:Pg:dbname=$dbname;host=$host;port=$port;options=$options;tty=$tty", "$username", "$password"); - -If a parameter is undefined PostgreSQL first looks for specific environment -variables and then it uses hard coded defaults: - - parameter environment variable hard coded default - -------------------------------------------------- - dbname PGDATABASE current userid - host PGHOST localhost - port PGPORT 5432 - options PGOPTIONS "" - tty PGTTY "" - username PGUSER current userid - password PGPASSWORD "" - -If a host is specified, the postmaster on this host needs to be -started with the C<-i> option (TCP/IP sockets). - -The options parameter specifies runtime options for the Postgres -backend. Common usage is to increase the number of buffers with -the C<-B> option. Also important is the C<-F> option, which disables -automatiic fsync() call after each transaction. For further details -please refer to the L<postgres>. - -For authentication with username and password appropriate entries have -to be made in pg_hba.conf. Please refer to the L<pg_hba.conf> and the -L<pg_passwd> for the different types of authentication. Note that for -these two parameters DBI distinguishes between empty and undefined. If -these parameters are undefined DBI substitutes the values of the environment -variables DBI_USER and DBI_PASS if present. - -=item B<available_drivers> - - @driver_names = DBI->available_drivers; - -Implemented by DBI, no driver-specific impact. - -=item B<data_sources> - - @data_sources = DBI->data_sources('Pg'); - -The driver supports this method. Note, that the necessary database -connect to the database template1 will be done on the localhost -without any user-authentication. Other preferences can only be set -with the environment variables PGHOST, DBI_USER and DBI_PASS. - -=item B<trace> - - DBI->trace($trace_level, $trace_file) - -Implemented by DBI, no driver-specific impact. - -=back - - -=head2 DBI Dynamic Attributes - -See Common Methods. - - -=head1 METHODS COMMON TO ALL HANDLES - -=over 4 - -=item B<err> - - $rv = $h->err; - -Supported by the driver as proposed by DBI. For the connect -method it returns PQstatus. In all other cases it returns -PQresultStatus of the current handle. - -=item B<errstr> - - $str = $h->errstr; - -Supported by the driver as proposed by DBI. It returns the -PQerrorMessage related to the current handle. - -=item B<state> - - $str = $h->state; - -This driver does not (yet) support the state method. - -=item B<trace> - - $h->trace($trace_level, $trace_filename); - -Implemented by DBI, no driver-specific impact. - -=item B<trace_msg> - - $h->trace_msg($message_text); - -Implemented by DBI, no driver-specific impact. - -=item B<func> - -This driver supports a variety of driver specific functions -accessible via the func interface: - - $attrs = $dbh->func($table, 'table_attributes'); - -This method returns for the given table a reference to an -array of hashes: - - NAME attribute name - TYPE attribute type - SIZE attribute size (-1 for variable size) - NULLABLE flag nullable - DEFAULT default value - CONSTRAINT constraint - PRIMARY_KEY flag is_primary_key - - $lobjId = $dbh->func($mode, 'lo_creat'); - -Creates a new large object and returns the object-id. $mode is a -bit-mask describing different attributes of the new object. Use -the following constants: - - $dbh->{pg_INV_WRITE} - $dbh->{pg_INV_READ} - -Upon failure it returns undef. - - $lobj_fd = $dbh->func($lobjId, $mode, 'lo_open'); - -Opens an existing large object and returns an object-descriptor -for use in subsequent lo_* calls. -For the mode bits see lo_create. Returns undef upon failure. -Note, that 0 is a perfectly correct object descriptor ! - - $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_write'); - -Writes $len bytes of $buf into the large object $lobj_fd. -Returns the number of bytes written and undef upon failure. - - $nbytes = $dbh->func($lobj_fd, $buf, $len, 'lo_read'); - -Reads $len bytes into $buf from large object $lobj_fd. -Returns the number of bytes read and undef upon failure. - - $loc = $dbh->func($lobj_fd, $offset, $whence, 'lo_lseek'); - -Change the current read or write location on the large -object $obj_id. Currently $whence can only be 0 (L_SET). -Returns the current location and undef upon failure. - - $loc = $dbh->func($lobj_fd, 'lo_tell'); - -Returns the current read or write location on the large -object $lobj_fd and undef upon failure. - - $lobj_fd = $dbh->func($lobj_fd, 'lo_close'); - -Closes an existing large object. Returns true upon success -and false upon failure. - - $lobjId = $dbh->func($filename, 'lo_import'); - -Imports a Unix file as large object and returns the object -id of the new object or undef upon failure. - - $ret = $dbh->func($lobjId, 'lo_export'); - -Exports a large object into a Unix file. Returns false upon -failure, true otherwise. - - $ret = $dbh->func($line, 'putline'); - -Used together with the SQL-command 'COPY table FROM STDIN' to -copy large amount of data into a table avoiding the overhead -of using single insert-comands. The application must explicitly -send the two characters "\." to indicate to the backend that -it has finished sending its data. See test.pl for an example -on how to use this function. - - $ret = $dbh->func($buffer, length, 'getline'); - -Used together with the SQL-command 'COPY table TO STDOUT' to -dump a complete table. See test.pl for an example on how to use -this function. - - -=back - - -=head1 ATTRIBUTES COMMON TO ALL HANDLES - -=over 4 - -=item B<Warn> (boolean, inherited) - -Implemented by DBI, no driver-specific impact. - -=item B<Active> (boolean, read-only) - -Supported by the driver as proposed by DBI. A database -handle is active while it is connected and statement -handle is active until it is finished. - -=item B<Kids> (integer, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<ActiveKids> (integer, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<CachedKids> (hash ref) - -Implemented by DBI, no driver-specific impact. - -=item B<CompatMode> (boolean, inherited) - -Not used by this driver. - -=item B<InactiveDestroy> (boolean) - -Implemented by DBI, no driver-specific impact. - -=item B<PrintError> (boolean, inherited) - -Implemented by DBI, no driver-specific impact. - -=item B<RaiseError> (boolean, inherited) - -Implemented by DBI, no driver-specific impact. - -=item B<ChopBlanks> (boolean, inherited) - -Supported by the driver as proposed by DBI. This -method is similar to the SQL-function RTRIM. - -=item B<LongReadLen> (integer, inherited) - -Implemented by DBI, not used by the driver. - -=item B<LongTruncOk> (boolean, inherited) - -Implemented by DBI, not used by the driver. - -=item B<Taint> (boolean, inherited) - -Implemented by DBI, no driver-specific impact. - -=item B<private_*> - -Implemented by DBI, no driver-specific impact. - -=back - - -=head1 DBI DATABASE HANDLE OBJECTS - -=head2 Database Handle Methods - -=over 4 - -=item B<selectrow_array> - - @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values); - -Implemented by DBI, no driver-specific impact. - -=item B<selectall_arrayref> - - $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values); - -Implemented by DBI, no driver-specific impact. - -=item B<selectcol_arrayref> - - $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values); - -Implemented by DBI, no driver-specific impact. - -=item B<prepare> - - $sth = $dbh->prepare($statement, \%attr); - -PostgreSQL does not have the concept of preparing -a statement. Hence the prepare method just stores -the statement after checking for place-holders. -No information about the statement is available -after preparing it. - -=item B<prepare_cached> - - $sth = $dbh->prepare_cached($statement, \%attr); - -Implemented by DBI, no driver-specific impact. -This method is not useful for this driver, because -preparing a statement has no database interaction. - -=item B<do> - - $rv = $dbh->do($statement, \%attr, @bind_values); - -Implemented by DBI, no driver-specific impact. See the -notes for the execute method elsewhere in this document. - -=item B<commit> - - $rc = $dbh->commit; - -Supported by the driver as proposed by DBI. See also the -notes about B<Transactions> elsewhere in this document. - -=item B<rollback> - - $rc = $dbh->rollback; - -Supported by the driver as proposed by DBI. See also the -notes about B<Transactions> elsewhere in this document. - -=item B<disconnect> - - $rc = $dbh->disconnect; - -Supported by the driver as proposed by DBI. - -=item B<ping> - - $rc = $dbh->ping; - -This driver supports the ping-method, which can be used to check the -validity of a database-handle. The ping method issues an empty query -and checks the result status. - -=item B<table_info> - - $sth = $dbh->table_info; - -Supported by the driver as proposed by DBI. This -method returns all tables and views which are owned by the -current user. It does not select any indices and sequences. -Also System tables are not selected. As TABLE_QUALIFIER the -reltype attribute is returned and the REMARKS are undefined. - -=item B<tables> - - @names = $dbh->tables; - -Supported by the driver as proposed by DBI. This -method returns all tables and views which are owned by the -current user. It does not select any indices and sequences. -Also system tables are not selected. - -=item B<type_info_all> - - $type_info_all = $dbh->type_info_all; - -Supported by the driver as proposed by DBI. -Only for SQL data-types and for frequently used data-types -information is provided. The mapping between the PostgreSQL typename -and the SQL92 data-type (if possible) has been done according to the -following table: - - +---------------+------------------------------------+ - | typname | SQL92 | - |---------------+------------------------------------| - | bool | BOOL | - | text | / | - | bpchar | CHAR(n) | - | varchar | VARCHAR(n) | - | int2 | SMALLINT | - | int4 | INT | - | int8 | / | - | money | / | - | float4 | FLOAT(p) p<7=float4, p<16=float8 | - | float8 | REAL | - | abstime | / | - | reltime | / | - | tinterval | / | - | date | / | - | time | / | - | datetime | / | - | timespan | TINTERVAL | - | timestamp | TIMESTAMP | - +---------------+------------------------------------+ - -For further details concerning the PostgreSQL specific data-types -please read the L<pgbuiltin>. - -=item B<type_info> - - @type_info = $dbh->type_info($data_type); - -Implemented by DBI, no driver-specific impact. - -=item B<quote> - - $sql = $dbh->quote($value, $data_type); - -This module implements it's own quote method. In addition to the -DBI method it doubles also the backslash, because PostgreSQL treats -a backslash as an escape character. - -=back - - -=head2 Database Handle Attributes - -=over 4 - -=item B<AutoCommit> (boolean) - -Supported by the driver as proposed by DBI. According to the -classification of DBI, PostgreSQL is a database, in which a -transaction must be explicitly started. Without starting a -transaction, every change to the database becomes immediately -permanent. The default of AutoCommit is on, which corresponds -to the default behavior of PostgreSQL. When setting AutoCommit -to off, a transaction will be started and every commit or rollback -will automatically start a new transaction. For details see the -notes about B<Transactions> elsewhere in this document. - -=item B<Driver> (handle) - -Implemented by DBI, no driver-specific impact. - -=item B<Name> (string, read-only) - -The default method of DBI is overridden by a driver specific -method, which returns only the database name. Anything else -from the connection string is stripped off. Note, that here -the method is read-only in contrast to the DBI specs. - -=item B<RowCacheSize> (integer) - -Implemented by DBI, not used by the driver. - -=item B<pg_auto_escape> (boolean) - -PostgreSQL specific attribute. If true, then quotes and backslashes in all -parameters will be escaped in the following way: - - escape quote with a quote (SQL) - escape backslash with a backslash except for octal presentation - -The default is on. Note, that PostgreSQL also accepts quotes, which -are escaped by a backslash. Any other ASCII character can be used -directly in a string constant. - -=item B<pg_INV_READ> (integer, read-only) - -Constant to be used for the mode in lo_creat and lo_open. - -=item B<pg_INV_WRITE> (integer, read-only) - -Constant to be used for the mode in lo_creat and lo_open. - -=back - - -=head1 DBI STATEMENT HANDLE OBJECTS - -=head2 Statement Handle Methods - -=over 4 - -=item B<bind_param> - - $rv = $sth->bind_param($param_num, $bind_value, \%attr); - -Supported by the driver as proposed by DBI. - -=item B<bind_param_inout> - -Not supported by this driver. - -=item B<execute> - - $rv = $sth->execute(@bind_values); - -Supported by the driver as proposed by DBI. -In addition to 'UPDATE', 'DELETE', 'INSERT' statements, for -which it returns always the number of affected rows, the execute -method can also be used for 'SELECT ... INTO table' statements. - -=item B<fetchrow_arrayref> - - $ary_ref = $sth->fetchrow_arrayref; - -Supported by the driver as proposed by DBI. - -=item B<fetchrow_array> - - @ary = $sth->fetchrow_array; - -Supported by the driver as proposed by DBI. - -=item B<fetchrow_hashref> - - $hash_ref = $sth->fetchrow_hashref; - -Supported by the driver as proposed by DBI. - -=item B<fetchall_arrayref> - - $tbl_ary_ref = $sth->fetchall_arrayref; - -Implemented by DBI, no driver-specific impact. - -=item B<finish> - - $rc = $sth->finish; - -Supported by the driver as proposed by DBI. - -=item B<rows> - - $rv = $sth->rows; - -Supported by the driver as proposed by DBI. -In contrast to many other drivers the number of rows is -available immediately after executing the statement. - -=item B<bind_col> - - $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr); - -Supported by the driver as proposed by DBI. - -=item B<bind_columns> - - $rc = $sth->bind_columns(\%attr, @list_of_refs_to_vars_to_bind); - -Supported by the driver as proposed by DBI. - -=item B<dump_results> - - $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh); - -Implemented by DBI, no driver-specific impact. - -=item B<blob_read> - - $blob = $sth->blob_read($id, $offset, $len); - -Supported by this driver as proposed by DBI. Implemented by DBI -but not documented, so this method might change. - -This method seems to be heavily influenced by the current implementation -of blobs in Oracle. Nevertheless we try to be as compatible as possible. -Whereas Oracle suffers from the limitation that blobs are related to tables -and every table can have only one blob (data-type LONG), PostgreSQL handles -its blobs independent of any table by using so called object identifiers. -This explains why the blob_read method is blessed into the STATEMENT package -and not part of the DATABASE package. Here the field parameter has been used -to handle this object identifier. The offset and len parameter may be set to -zero, in which case the driver fetches the whole blob at once. - -Starting with PostgreSQL-6.5 every access to a blob has to be put into a -transaction. This holds even for a read-only access. - -See also the PostgreSQL-specific functions concerning blobs which are -available via the func-interface. - -For further information and examples about blobs, please read the chapter -about Large Objects in the PostgreSQL Programmer's Guide. - -=back - - -=head2 Statement Handle Attributes - -=over 4 - -=item B<NUM_OF_FIELDS> (integer, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<NUM_OF_PARAMS> (integer, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<NAME> (array-ref, read-only) - -Supported by the driver as proposed by DBI. - -=item B<NAME_lc> (array-ref, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<NAME_uc> (array-ref, read-only) - -Implemented by DBI, no driver-specific impact. - -=item B<TYPE> (array-ref, read-only) - -Supported by the driver as proposed by DBI, with -the restriction, that the types are PostgreSQL -specific data-types which do not correspond to -international standards. - -=item B<PRECISION> (array-ref, read-only) - -Not supported by the driver. - -=item B<SCALE> (array-ref, read-only) - -Not supported by the driver. - -=item B<NULLABLE> (array-ref, read-only) - -Not supported by the driver. - -=item B<CursorName> (string, read-only) - -Not supported by the driver. See the note about -B<Cursors> elsewhere in this document. - -=item B<Statement> (string, read-only) - -Supported by the driver as proposed by DBI. - -=item B<RowCache> (integer, read-only) - -Not supported by the driver. - -=item B<pg_size> (array-ref, read-only) - -PostgreSQL specific attribute. It returns a reference to an -array of integer values for each column. The integer shows -the size of the column in bytes. Variable length columns -are indicated by -1. - -=item B<pg_type> (hash-ref, read-only) - -PostgreSQL specific attribute. It returns a reference to an -array of strings for each column. The string shows the name -of the data_type. - -=item B<pg_oid_status> (integer, read-only) - -PostgreSQL specific attribute. It returns the OID of the last -INSERT command. - -=item B<pg_cmd_status> (integer, read-only) - -PostgreSQL specific attribute. It returns the type of the last -command. Possible types are: INSERT, DELETE, UPDATE, SELECT. - -=back - - -=head1 FURTHER INFORMATION - -=head2 Transactions - -The transaction behavior is now controlled with the attribute AutoCommit. -For a complete definition of AutoCommit please refer to the DBI documentation. - -According to the DBI specification the default for AutoCommit is TRUE. -In this mode, any change to the database becomes valid immediately. Any -'begin', 'commit' or 'rollback' statement will be rejected. - -If AutoCommit is switched-off, immediately a transaction will be started by -issuing a 'begin' statement. Any 'commit' or 'rollback' will start a new -transaction. A disconnect will issue a 'rollback' statement. - - -=head2 Large Objects - -The driver supports all large-objects related functions provided by -libpq via the func-interface. Please note, that starting with -PoostgreSQL-65. any access to a large object - even read-only - -has to be put into a transaction ! - - -=head2 Cursors - -Although PostgreSQL has a cursor concept, it has not -been used in the current implementation. Cursors in -PostgreSQL can only be used inside a transaction block. -Because only one transaction block at a time is allowed, -this would have implied the restriction, not to use -any nested SELECT statements. Hence the execute method -fetches all data at once into data structures located -in the frontend application. This has to be considered -when selecting large amounts of data ! - - -=head2 Data-Type bool - -The current implementation of PostgreSQL returns 't' for true and 'f' for -false. From the perl point of view a rather unfortunate choice. The DBD-Pg -module translates the result for the data-type bool in a perl-ish like manner: -'f' -> '0' and 't' -> '1'. This way the application does not have to check -the database-specific returned values for the data-type bool, because perl -treats '0' as false and '1' as true. - -PostgreSQL Version 6.2 considers the input 't' as true -and anything else as false. -PostgreSQL Version 6.3 considers the input 't', '1' and 1 as true -and anything else as false. -PostgreSQL Version 6.4 considers the input 't', '1' and 'y' as true -and any other character as false. - - -=head1 SEE ALSO - -L<DBI> - - -=head1 AUTHORS - -=item * -DBI and DBD-Oracle by Tim Bunce (Tim.Bunce(a)ig.co.uk) - -=item * -DBD-Pg by Edmund Mergl (E.Mergl(a)bawue.de) - - Major parts of this package have been copied from DBI and DBD-Oracle. - - -=head1 COPYRIGHT - -The DBD::Pg module is free software. -You may distribute under the terms of either the GNU General Public -License or the Artistic License, as specified in the Perl README file, -with the exception that it cannot be placed on a CD-ROM or similar media -for commercial distribution without the prior approval of the author. - - -=head1 ACKNOWLEDGMENTS - -See also B<DBI/ACKNOWLEDGMENTS>. - -=cut diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.xs b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.xs deleted file mode 100644 index c84f987..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/Pg.xs +++ /dev/null @@ -1,592 +0,0 @@ -/* - $Id: Pg.xs,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - Copyright (c) 1997,1998,1999,2000 Edmund Mergl - Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. - -*/ - - -#include "Pg.h" - - -#ifdef _MSC_VER -#define strncasecmp(a,b,c) _strnicmp((a),(b),(c)) -#endif - - - -DBISTATE_DECLARE; - - -MODULE = DBD::Pg PACKAGE = DBD::Pg - -PROTOTYPES: DISABLE - -BOOT: - items = 0; /* avoid 'unused variable' warning */ - DBISTATE_INIT; - /* XXX this interface will change: */ - DBI_IMP_SIZE("DBD::Pg::dr::imp_data_size", sizeof(imp_drh_t)); - DBI_IMP_SIZE("DBD::Pg::db::imp_data_size", sizeof(imp_dbh_t)); - DBI_IMP_SIZE("DBD::Pg::st::imp_data_size", sizeof(imp_sth_t)); - dbd_init(DBIS); - - -# ------------------------------------------------------------ -# driver level interface -# ------------------------------------------------------------ -MODULE = DBD::Pg PACKAGE = DBD::Pg::dr - -# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-( -void -discon_all_(drh) - SV * drh - ALIAS: - disconnect_all = 1 - CODE: - D_imp_drh(drh); - ST(0) = dbd_discon_all(drh, imp_drh) ? &sv_yes : &sv_no; - - - -# ------------------------------------------------------------ -# database level interface -# ------------------------------------------------------------ -MODULE = DBD::Pg PACKAGE = DBD::Pg::db - -void -_login(dbh, dbname, username, pwd) - SV * dbh - char * dbname - char * username - char * pwd - CODE: - D_imp_dbh(dbh); - ST(0) = pg_db_login(dbh, imp_dbh, dbname, username, pwd) ? &sv_yes : &sv_no; - - -int -_ping(dbh) - SV * dbh - CODE: - int ret; - ret = dbd_db_ping(dbh); - if (ret == 0) { - XST_mUNDEF(0); - } - else { - XST_mIV(0, ret); - } - -void -commit(dbh) - SV * dbh - CODE: - D_imp_dbh(dbh); - if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) { - warn("commit ineffective with AutoCommit enabled"); - } - ST(0) = dbd_db_commit(dbh, imp_dbh) ? &sv_yes : &sv_no; - - -void -rollback(dbh) - SV * dbh - CODE: - D_imp_dbh(dbh); - if (DBIc_has(imp_dbh, DBIcf_AutoCommit)) { - warn("rollback ineffective with AutoCommit enabled"); - } - ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &sv_yes : &sv_no; - - -void -disconnect(dbh) - SV * dbh - CODE: - D_imp_dbh(dbh); - if ( !DBIc_ACTIVE(imp_dbh) ) { - XSRETURN_YES; - } - /* pre-disconnect checks and tidy-ups */ - if (DBIc_CACHED_KIDS(imp_dbh)) { - SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); - DBIc_CACHED_KIDS(imp_dbh) = Nullhv; - } - /* Check for disconnect() being called whilst refs to cursors */ - /* still exists. This possibly needs some more thought. */ - if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !dirty) { - char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? "" : "s"; - warn("disconnect(%s) invalidates %d active statement%s. %s", - SvPV(dbh,na), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural, - "Either destroy statement handles or call finish on them before disconnecting."); - } - ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &sv_yes : &sv_no; - - -void -STORE(dbh, keysv, valuesv) - SV * dbh - SV * keysv - SV * valuesv - CODE: - D_imp_dbh(dbh); - ST(0) = &sv_yes; - if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv)) { - if (!DBIS->set_attr(dbh, keysv, valuesv)) { - ST(0) = &sv_no; - } - } - - -void -FETCH(dbh, keysv) - SV * dbh - SV * keysv - CODE: - D_imp_dbh(dbh); - SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv); - if (!valuesv) { - valuesv = DBIS->get_attr(dbh, keysv); - } - ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */ - - -void -DESTROY(dbh) - SV * dbh - PPCODE: - D_imp_dbh(dbh); - ST(0) = &sv_yes; - if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */ - if (DBIc_WARN(imp_dbh) && !dirty && dbis->debug >= 2) { - warn("Database handle %s DESTROY ignored - never set up", SvPV(dbh,na)); - } - } - else { - /* pre-disconnect checks and tidy-ups */ - if (DBIc_CACHED_KIDS(imp_dbh)) { - SvREFCNT_dec(DBIc_CACHED_KIDS(imp_dbh)); - DBIc_CACHED_KIDS(imp_dbh) = Nullhv; - } - if (DBIc_IADESTROY(imp_dbh)) { /* want's ineffective destroy */ - DBIc_ACTIVE_off(imp_dbh); - } - if (DBIc_ACTIVE(imp_dbh)) { - if (DBIc_WARN(imp_dbh) && (!dirty || dbis->debug >= 3)) { - warn("Database handle destroyed without explicit disconnect"); - } - /* The application has not explicitly disconnected. That's bad. */ - /* To ensure integrity we *must* issue a rollback. This will be */ - /* harmless if the application has issued a commit. If it hasn't */ - /* then it'll ensure integrity. Consider a Ctrl-C killing perl */ - /* between two statements that must be executed as a transaction. */ - /* Perl will call DESTROY on the dbh and, if we don't rollback, */ - /* the server will automatically commit! Bham! Corrupt database! */ - if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) { - dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */ - } - dbd_db_disconnect(dbh, imp_dbh); - } - dbd_db_destroy(dbh, imp_dbh); - } - - -# driver specific functions - - -void -lo_open(dbh, lobjId, mode) - SV * dbh - unsigned int lobjId - int mode - CODE: - int ret = pg_db_lo_open(dbh, lobjId, mode); - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - -void -lo_close(dbh, fd) - SV * dbh - int fd - CODE: - ST(0) = (-1 != pg_db_lo_close(dbh, fd)) ? &sv_yes : &sv_no; - - -void -lo_read(dbh, fd, buf, len) - SV * dbh - int fd - char * buf - int len - PREINIT: - SV *bufsv = SvROK(ST(2)) ? SvRV(ST(2)) : ST(2); - int ret; - CODE: - buf = SvGROW(bufsv, len + 1); - ret = pg_db_lo_read(dbh, fd, buf, len); - if (ret > 0) { - SvCUR_set(bufsv, ret); - *SvEND(bufsv) = '\0'; - sv_setpvn(ST(2), buf, ret); - SvSETMAGIC(ST(2)); - } - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_write(dbh, fd, buf, len) - SV * dbh - int fd - char * buf - int len - CODE: - int ret = pg_db_lo_write(dbh, fd, buf, len); - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_lseek(dbh, fd, offset, whence) - SV * dbh - int fd - int offset - int whence - CODE: - int ret = pg_db_lo_lseek(dbh, fd, offset, whence); - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_creat(dbh, mode) - SV * dbh - int mode - CODE: - int ret = pg_db_lo_creat(dbh, mode); - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_tell(dbh, fd) - SV * dbh - int fd - CODE: - int ret = pg_db_lo_tell(dbh, fd); - ST(0) = (-1 != ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_unlink(dbh, lobjId) - SV * dbh - unsigned int lobjId - CODE: - ST(0) = (-1 != pg_db_lo_unlink(dbh, lobjId)) ? &sv_yes : &sv_no; - - -void -lo_import(dbh, filename) - SV * dbh - char * filename - CODE: - unsigned int ret = pg_db_lo_import(dbh, filename); - ST(0) = (ret) ? sv_2mortal(newSViv(ret)) : &sv_undef; - - -void -lo_export(dbh, lobjId, filename) - SV * dbh - unsigned int lobjId - char * filename - CODE: - ST(0) = (-1 != pg_db_lo_export(dbh, lobjId, filename)) ? &sv_yes : &sv_no; - - -void -putline(dbh, buf) - SV * dbh - char * buf - CODE: - int ret = pg_db_putline(dbh, buf); - ST(0) = (-1 != ret) ? &sv_yes : &sv_no; - - -void -getline(dbh, buf, len) - PREINIT: - SV *bufsv = SvROK(ST(1)) ? SvRV(ST(1)) : ST(1); - INPUT: - SV * dbh - int len - char * buf = sv_grow(bufsv, len); - CODE: - int ret = pg_db_getline(dbh, buf, len); - if (*buf == '\\' && *(buf+1) == '.') { - ret = -1; - } - sv_setpv((SV*)ST(1), buf); - SvSETMAGIC(ST(1)); - ST(0) = (-1 != ret) ? &sv_yes : &sv_no; - - -void -endcopy(dbh) - SV * dbh - CODE: - ST(0) = (-1 != pg_db_endcopy(dbh)) ? &sv_yes : &sv_no; - - -# -- end of DBD::Pg::db - - -# ------------------------------------------------------------ -# statement interface -# ------------------------------------------------------------ -MODULE = DBD::Pg PACKAGE = DBD::Pg::st - -void -_prepare(sth, statement, attribs=Nullsv) - SV * sth - char * statement - SV * attribs - CODE: - { - D_imp_sth(sth); - D_imp_dbh_from_sth; - DBD_ATTRIBS_CHECK("_prepare", sth, attribs); - if (!strncasecmp(statement, "begin", 5) || - !strncasecmp(statement, "end", 4) || - !strncasecmp(statement, "commit", 6) || - !strncasecmp(statement, "abort", 5) || - !strncasecmp(statement, "rollback", 8) ) { - warn("please use DBI functions for transaction handling"); - ST(0) = &sv_no; - } else { - ST(0) = dbd_st_prepare(sth, imp_sth, statement, attribs) ? &sv_yes : &sv_no; - } - } - - -void -rows(sth) - SV * sth - CODE: - D_imp_sth(sth); - XST_mIV(0, dbd_st_rows(sth, imp_sth)); - - -void -bind_param(sth, param, value, attribs=Nullsv) - SV * sth - SV * param - SV * value - SV * attribs - CODE: - { - IV sql_type = 0; - D_imp_sth(sth); - if (attribs) { - if (SvNIOK(attribs)) { - sql_type = SvIV(attribs); - attribs = Nullsv; - } - else { - SV **svp; - DBD_ATTRIBS_CHECK("bind_param", sth, attribs); - /* XXX we should perhaps complain if TYPE is not SvNIOK */ - DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type); - } - } - ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0) ? &sv_yes : &sv_no; - } - - -void -bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv) - SV * sth - SV * param - SV * value_ref - IV maxlen - SV * attribs - CODE: - { - IV sql_type = 0; - D_imp_sth(sth); - if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG) { - croak("bind_param_inout needs a reference to a scalar value"); - } - if (SvREADONLY(SvRV(value_ref))) { - croak(no_modify); - } - if (attribs) { - if (SvNIOK(attribs)) { - sql_type = SvIV(attribs); - attribs = Nullsv; - } - else { - SV **svp; - DBD_ATTRIBS_CHECK("bind_param", sth, attribs); - DBD_ATTRIB_GET_IV(attribs, "TYPE", 4, svp, sql_type); - } - } - ST(0) = dbd_bind_ph(sth, imp_sth, param, SvRV(value_ref), sql_type, attribs, TRUE, maxlen) ? &sv_yes : &sv_no; - } - - -void -execute(sth, ...) - SV * sth - CODE: - D_imp_sth(sth); - int ret; - if (items > 1) { - /* Handle binding supplied values to placeholders */ - int i; - SV *idx; - imp_sth->all_params_len = 0; /* used for malloc of statement string in case we have placeholders */ - if (items-1 != DBIc_NUM_PARAMS(imp_sth)) { - croak("execute called with %ld bind variables, %d needed", items-1, DBIc_NUM_PARAMS(imp_sth)); - XSRETURN_UNDEF; - } - idx = sv_2mortal(newSViv(0)); - for(i=1; i < items ; ++i) { - sv_setiv(idx, i); - if (!dbd_bind_ph(sth, imp_sth, idx, ST(i), 0, Nullsv, FALSE, 0)) { - XSRETURN_UNDEF; /* dbd_bind_ph already registered error */ - } - } - } - ret = dbd_st_execute(sth, imp_sth); - /* remember that dbd_st_execute must return <= -2 for error */ - if (ret == 0) { /* ok with no rows affected */ - XST_mPV(0, "0E0"); /* (true but zero) */ - } - else if (ret < -1) { /* -1 == unknown number of rows */ - XST_mUNDEF(0); /* <= -2 means error */ - } - else { - XST_mIV(0, ret); /* typically 1, rowcount or -1 */ - } - - -void -fetchrow_arrayref(sth) - SV * sth - ALIAS: - fetch = 1 - CODE: - D_imp_sth(sth); - AV *av = dbd_st_fetch(sth, imp_sth); - ST(0) = (av) ? sv_2mortal(newRV_inc((SV *)av)) : &sv_undef; - - -void -fetchrow_array(sth) - SV * sth - ALIAS: - fetchrow = 1 - PPCODE: - D_imp_sth(sth); - AV *av; - av = dbd_st_fetch(sth, imp_sth); - if (av) { - int num_fields = AvFILL(av)+1; - int i; - EXTEND(sp, num_fields); - for(i=0; i < num_fields; ++i) { - PUSHs(AvARRAY(av)[i]); - } - } - - -void -finish(sth) - SV * sth - CODE: - D_imp_sth(sth); - D_imp_dbh_from_sth; - if (!DBIc_ACTIVE(imp_dbh)) { - /* Either an explicit disconnect() or global destruction */ - /* has disconnected us from the database. Finish is meaningless */ - /* XXX warn */ - XSRETURN_YES; - } - if (!DBIc_ACTIVE(imp_sth)) { - /* No active statement to finish */ - XSRETURN_YES; - } - ST(0) = dbd_st_finish(sth, imp_sth) ? &sv_yes : &sv_no; - - -void -blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0) - SV * sth - int field - long offset - long len - SV * destrv - long destoffset - CODE: - { - D_imp_sth(sth); - if (!destrv) { - destrv = sv_2mortal(newRV_inc(sv_2mortal(newSViv(0)))); - } - ST(0) = dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset) ? SvRV(destrv) : &sv_undef; - } - -void -STORE(sth, keysv, valuesv) - SV * sth - SV * keysv - SV * valuesv - CODE: - D_imp_sth(sth); - ST(0) = &sv_yes; - if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv)) { - if (!DBIS->set_attr(sth, keysv, valuesv)) { - ST(0) = &sv_no; - } - } - - -# FETCH renamed and ALIAS'd to avoid case clash on VMS :-( -void -FETCH_attrib(sth, keysv) - SV * sth - SV * keysv - ALIAS: - FETCH = 1 - CODE: - D_imp_sth(sth); - SV *valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv); - if (!valuesv) { - valuesv = DBIS->get_attr(sth, keysv); - } - ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */ - - -void -DESTROY(sth) - SV * sth - PPCODE: - D_imp_sth(sth); - ST(0) = &sv_yes; - if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */ - if (DBIc_WARN(imp_sth) && !dirty && dbis->debug >= 2) { - warn("Statement handle %s DESTROY ignored - never set up", SvPV(sth,na)); - } - } - else { - if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */ - DBIc_ACTIVE_off(imp_sth); - } - if (DBIc_ACTIVE(imp_sth)) { - dbd_st_finish(sth, imp_sth); - } - dbd_st_destroy(sth, imp_sth); - } - - -# end of Pg.xs diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README deleted file mode 100644 index ed6a00b..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README +++ /dev/null @@ -1,158 +0,0 @@ - -DBD::Pg -- a PostgreSQL interface for Perl 5. - - $Id: README,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - Copyright (c) 1997,1998,1999,2000 Edmund Mergl - Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. - - -DESCRIPTION: ------------- - -This is version 0.95 of DBD-Pg. -DBD-Pg is a PostgreSQL interface for Perl5 using DBI. - -For further information about DBI look at: - - http://www.isc.org/services/public/lists/dbi-lists.html - - -RECENT CHANGES: ---------------- - -- add Win32 port - - -COPYRIGHT: ----------- - -You may distribute under the terms of either the GNU General Public -License or the Artistic License, as specified in the Perl README file. - - -HOW TO GET THE LATEST VERSION: ------------------------------- - -Use the following URL to look for new versions of this module: - - http://www.perl.com/CPAN/modules/by-module/DBD/ - -Note, that this request will be redirected automatically to the -nearest CPAN site. - -A precompiled package for Windows-NT is available at: - - http://www.edmund-mergl.de/export/DBD-Pg.zip - - -IF YOU HAVE PROBLEMS: ---------------------- - -Please send comments and bug-reports to <dbi-users(a)fugue.com>> - -Please include the output of perl -v, - and perl -V, - the version of PostgreSQL, - the version of DBD-Pg, - and the version of DBI -in your bug-report. - - -REQUIREMENTS: -------------- - - - build, test and install Perl 5 (at least 5.003) - - build, test and install the DBI module (at least 1.00) - - build, test and install PostgreSQL (at least 6.5) - - -PLATFORMS: ----------- - - This release of DBD-Pg has been developed using Linux 2.2 with - dynamic loading for the perl extensions. Let me know, if there - are any problems with other platforms. - - -INSTALLATION: -------------- - -The Makefile checks the environment variables POSTGRES_INCLUDE and -POSTGRES_LIB, to find the library lipq.so and the proper include files. - -1. perl Makefile.PL -2. make -3. make test -4. make install - -( 1. to 3. as normal user, not as root ! ) - -For Windows-NT use the pre-compiled package DBD-Pg.zip. -Unzip the package and follow the instructions in the -README. - - -TESTING: --------- - -Run 'make test'. -Note, that the user running this script must have been created with -the access rights to create databases *AND* users ! Do not run this -script as root ! - -If testing fails with the message 'login failed', please check if access -to the database template1 as well as pgperltest is not protected in pg_hba.conf. - -If you are using the shared library libpq.so check if your dynamic loader -finds libpq.so. With Linux the command /sbin/ldconfig -v should tell you, -where it finds libpq.so. If ldconfig does not find libpq.so, either add an -appropriate entry to /etc/ld.so.conf and re-run ldconfig or add the path to -the environment variable LD_LIBRARY_PATH. -A typical error message resulting from not finding libpq.so is: - install_driver(Pg) failed: Can't load './blib/arch/auto/DBD/Pg/Pg.so' - for module DBD::Pg: File not found at - -Some linux distributions have an incomplete perl installation. -If you have compile errors like "XS_VERSION_BOOTCHECK undeclared", make a - 'find .../lib/perl5 -name XSUB.h -print' -If this file is not present, you need to recompile and reinstall perl. - -SGI users: if you get segmentation faults make sure, you use the malloc which - comes with perl when compiling perl (the default is not to). - "David R. Noble" <drnoble(a)engsci.sandia.gov> - -HP users: if you get error messages like: - can't open shared library: .../lib/libpq.sl - No such file or directory - when running the test script, try to replace the - 'shared' option in the LDDFLAGS with 'archive'. - Dan Lauterbach <danla(a)dimensional.com> - -FreeBSD users: if you get during make test the error message: - 'DBD driver has not implemented the AutoCommit attribute' - recompile the DBI module and the DBD-Pg module and disable - optimization. This error message is due to the broken - optimization in gcc-2.7.2.1. - -Sun Users: if you get compile errors like: - /usr/include/string.h:57: parse error before `]' - then you need to remove from pgsql/include/libpq-fe.h - the define for strerror, which clashes with the definition - in the standard include file. - - -Win32 Users: Running DBD-Pg scripts on Win32 needs some configuration work - on the server side: - - add a postgres user with the same name as the NT-User (eg Administrator) - - make sure, that your pg_hba.conf on the server is configured, - such that a connection from another host will be accepted - ---------------------------------------------------------------------------- - - Edmund Mergl <E.Mergl(a)bawue.de> July 10, 2000 - ---------------------------------------------------------------------------- diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README.win32 b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README.win32 deleted file mode 100644 index bb4c060..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/README.win32 +++ /dev/null @@ -1,75 +0,0 @@ - -$Id: README.win32,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - -###################################################################### -# # -# a pre-compiled package is available at: # -# # -# http://www.edmund-mergl.de/export/DBD-Pg.zip # -# # -###################################################################### - - -Here is a step-by-step procedure for getting DBD-Pg to work on Windows NT. -This Port has been done by Bob Kline <bkline(a)rksystems.com>. - - -prerequisites: (older versions might also work, but these are the versions I used) --------------- - - - Windows NT4 SP4 - - Visual Studio 6.0 - - ActivePerl-5_6_0_613 with DBI-1.13 - - postgresql-7.0.2 - - DBD-Pg-0.95 - -Here we assume, that perl and postgresql have been installed in C:\ -Now perform the following steps: - - -1. compile libpq ----------------- - -set POSTGRES_HOME=C:\postgresql-7.0.2 -cd postgresql-7.0.2 -mkdir lib -mkdir include -cd src -copy include\port\win32.h include\os.h -edit interfaces\libpq\fe-connect.c and add as first statement in connectDBStart() the following code: - #ifdef WIN32 - static int WeHaveCalledWSAStartup; - if (!WeHaveCalledWSAStartup) { - WSADATA wsaData; - if (WSAStartup(MAKEWORD(1, 1), &wsaData)) { - printfPQExpBuffer(&conn->errorMessage, "WSAStartup failed: errno=%d\n", h_errno); - goto connect_errReturn; - } - WeHaveCalledWSAStartup = 1; - } - #endif -edit interfaces\libpq\win32.mak and change the flag /ML to /MD: CPP_PROJ=/nologo /MD ... -nmake /f win32.mak -cd .. -copy src\interfaces\libpq\Release\libpq.lib lib -copy src\interfaces\libpq\libpq-fe.h include -copy src\include\postgres_ext.h include -cd .. - - -2. build DBD-Pg ---------------- - -cd DBD-Pg -perl Makefile.PL CAPI=TRUE -nmake -set the environment variable PGHOST to the name of the postgresql server: set PGHOST=myserver -add on the server a postgres user with the same name as the NT-User (eg Administrator) -make sure, that your pg_hba.conf on the server is configured, such that a connection from another host will be accepted -mkdir C:\tmp -nmake test (expect to get errors concerning blobs) -nmake install - - -# EOF diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbd-pg.pod b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbd-pg.pod deleted file mode 100644 index d25cec2..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbd-pg.pod +++ /dev/null @@ -1,411 +0,0 @@ - -# $Id: dbd-pg.pod,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - -=head1 NAME - -DBD::Pg - PostgreSQL database driver for the DBI module - -=head1 DESCRIPTION - -DBD::Pg is a Perl module which works with the DBI module to provide -access to PostgreSQL databases. - -=head1 DBD::Pg - -=begin docbook - - - -=end docbook - -=head1 - -=head2 Version - -Version 0.91. - -=head2 Author and Contact Details - -The driver author is Edmund Mergl. He can be contacted via the -I<dbi-users> mailing list. - - -=head2 Supported Database Versions and Options - -The DBD-Pg-0.92 module supports Postgresql 6.5. - - -=head2 Connect Syntax - -The C<DBI-E<gt>connect()> Data Source Name, or I<DSN>, can be one of the -following: - - dbi:Pg:dbname=$dbname - dbi:Pg:dbname=$dbname;host=$host;port=$port;options=$options;tty=$tty - -All parameters, including the userid and password parameter of the -connect command, have a hard-coded default which can be overridden -by setting appropriate environment variables: - - Parameter Environment Variable Default - --------- -------------------- -------------- - dbname PGDATABASE current userid - host PGHOST localhost - port PGPORT 5432 - options PGOPTIONS "" - tty PGTTY "" - username PGUSER current userid - password PGPASSWORD "" - -There are no driver specific attributes for the C<DBI->connect()> method. - - -=head2 Numeric Data Handling - -Postgresql supports the following numeric types: - - Postgresql Range - ---------- -------------------------- - int2 -32768 to +32767 - int4 -2147483648 to +2147483647 - float4 6 decimal places - float8 15 decimal places - -Some platforms also support the int8 type. -C<DBD::Pg> always returns all numbers as strings. - - -=head2 String Data Handling - -Postgresql supports the following string data types: - - CHAR single character - CHAR(size) fixed length blank-padded - VARCHAR(size) variable length with limit - TEXT variable length - -All string data types have a limit of 4096 bytes. -The CHAR type is fixed length and blank padded. - -There is no special handling for data with the 8th bit set. They -are stored unchanged in the database. -None of the character types can store embedded nulls and Unicode is -not formally supported. - -Strings can be concatenated using the C<||> operator. - - -=head2 Date Data Handling - -Postgresql supports the following date time data types: - - Type Storage Recommendation Description - --------- -------- -------------------------- ---------------------------- - abstime 4 bytes original date and time limited range - date 4 bytes SQL92 type wide range - datetime 8 bytes best general date and time wide range, high precision - interval 12 bytes SQL92 type equivalent to timespan - reltime 4 bytes original time interval limited range, low precision - time 4 bytes SQL92 type wide range - timespan 12 bytes best general time interval wide range, high precision - timestamp 4 bytes SQL92 type limited range - - Data Type Range Resolution - ---------- ---------------------------------- ----------- - abstime 1901-12-14 2038-01-19 1 sec - timestamp 1901-12-14 2038-01-19 1 sec - reltime -68 years +68 years 1 sec - tinterval -178000000 years +178000000 years 1 microsec - timespan -178000000 years 178000000 years 1 microsec - date 4713 BC 32767 AD 1 day - datetime 4713 BC 1465001 AD 1 microsec - time 00:00:00:00 23:59:59:99 1 microsec - -Postgresql supports a range of date formats: - - Name Example - ----------- ---------------------- - ISO 1997-12-17 0:37:16-08 - SQL 12/17/1997 07:37:16.00 PST - Postgres Wed Dec 17 07:37:16 1997 PST - European 17/12/1997 15:37:16.00 MET - NonEuropean 12/17/1997 15:37:16.00 MET - US 12/17/1997 07:37:16.00 MET - -The default output format does not depend on the client/server locale. -It depends on, in increasing priority: the PGDATESTYLE environment -variable at the server, the PGDATESTYLE environment variable at the client, and -the C<SET DATESTYLE> SQL command. - -All of the formats described above can be used for input. A great many -others can also be used. There is no specific default input format. -If the format of a date input is ambiguous then the current DATESTYLE -is used to help disambiguate. - -If you specify a date/time value without a time component, the default -time is 00:00:00 (midnight). To specify a date/time value without a date -is not allowed. -If a date with a two digit year is input then if the year was less than -70, add 2000; otherwise, add 1900. - -The currect date/time is returned by the keyword C<'now'> or C<'current'>, -which has to be casted to a valid data type. For example: - - SELECT 'now'::datetime - -Postgresql supports a range of date time functions for converting -between types, extracting parts of a date time value, truncating to a -given unit, etc. The usual arithmetic can be performed on date and -interval values, e.g., date-date=interval, etc. - -The following SQL expression can be used to convert an integer "seconds -since 1-jan-1970 GMT" value to the corresponding database date time: - - DATETIME(unixtime_field) - -and to do the reverse: - - DATE_PART('epoch', datetime_field) - -The server stores all dates internally in GMT. Times are converted to -local time on the database server before being sent to the client -frontend, hence by default are in the server time zone. - -The TZ environment variable is used by the server as default time -zone. The PGTZ environment variable on the client side is used to send -the time zone information to the backend upon connection. The SQL C<SET -TIME ZONE> command can set the time zone for the current session. - - -=head2 LONG/BLOB Data Handling - -Postgresql handles BLOBS using a so called "large objects" type. The -handling of this type differs from all other data types. The data are -broken into chunks, which are stored in tuples in the database. Access -to large objects is given by an interface which is modelled closely -after the UNIX file system. The maximum size is limited by the file -size of the operating system. - - -If you just select the field, you get a "large object identifier" and -not the data itself. The I<LongReadLen> and I<LongTruncOk> attributes are -not implemented because they don't make sense in this case. The only -method implemented by the driver is the undocumented DBI method -C<blob_read()>. - - -=head2 Other Data Handling issues - -The C<DBD::Pg> driver supports the C<type_info()> method. - -Postgresql supports automatic conversions between data types wherever -it's reasonable. - -=head2 Transactions, Isolation and Locking - -Postgresql supports transactions. -The current default isolation transaction level is "Serializable" and -is currently implemented using table level locks. Both may change. -No other isolation levels for transactions are supported. - -With AutoCommit on, a query never places a lock on a table. Readers -never block writers and writers never block readers. This behavior -changes whenever a transaction is started (AutoCommit off). Then a -query induces a shared lock on a table and blocks anyone else -until the transaction has been finished. - -The C<LOCK TABLE table_name> statement can be used to apply an explicit -lock on a table. This only works inside a transaction (AutoCommit off). - -To ensure that a table being selected does not change before you make -an update later in the transaction, you must explicitly lock it with a -C<LOCK TABLE> statement before executing the select. - - -=head2 No-Table Expression Select Syntax - -To select a constant expression, that is, an expression that doesn't involve -data from a database table or view, just omit the "from" clause. -Here's an example that selects the current time as a datetime: - - SELECT 'now'::datetime; - -=head2 Table Join Syntax - -Outer joins are not supported. Inner joins use the traditional syntax. - -=head2 Table and Column Names - -The max size of table and column names cannot exceed 31 charaters in -length. -Only alphanumeric characters can be used; the first character must -be a letter. - -If an identifier is enclosed by double quotation marks (C<">), it can -contain any combination of characters except double quotation marks. - -Postgresql converts all identifiers to lower-case unless enclosed in -double quotation marks. -National character set characters can be used, if enclosed in quotation -marks. - - -=head2 Case Sensitivity of LIKE Operator - -Postgresql has the following string matching operators: - - Glyph Description Example - ----- ---------------------------------------- ----------------------------- - ~~ Same as SQL "LIKE" operator 'scrappy,marc' ~~ '%scrappy%' - !~~ Same as SQL "NOT LIKE" operator 'bruce' !~~ '%al%' - ~ Match (regex), case sensitive 'thomas' ~ '.*thomas.*' - ~* Match (regex), case insensitive 'thomas' ~* '.*Thomas.*' - !~ Does not match (regex), case sensitive 'thomas' !~ '.*Thomas.*' - !~* Does not match (regex), case insensitive 'thomas' !~ '.*vadim.*' - - -=head2 Row ID - -The Postgresql "row id" pseudocolumn is called I<oid>, object identifier. -It can be treated as a string and used to rapidly (re)select rows. - - -=head2 Automatic Key or Sequence Generation - -Postgresql does not support automatic key generation such as "auto -increment" or "system generated" keys. - -However, Postgresql does support "sequence generators". Any number of -named sequence generators can be created in a database. Sequences -are used via functions called C<NEXTVAL> and C<CURRVAL>. Typical usage: - - INSERT INTO table (k, v) VALUES (nextval('seq_name'), ?); - -To get the value just inserted, you can use the corresponding C<currval()> -SQL function in the same session, or - - SELECT last_value FROM seq_name - - -=head2 Automatic Row Numbering and Row Count Limiting - -Postgresql does not support any way of automatically numbering returned rows. - - -=head2 Parameter Binding - -Parameter binding is emulated by the driver. -Both the C<?> and C<:1> style of placeholders are supported. - -The TYPE attribute of the C<bind_param()> method may be used to -influence how parameters are treated. These SQL types are bound as -VARCHAR: SQL_NUMERIC, SQL_DECIMAL, SQL_INTEGER, SQL_SMALLINT, -SQL_FLOAT, SQL_REAL, SQL_DOUBLE, SQL_VARCHAR. - -The SQL_CHAR type is bound as a CHAR thus enabling fixed-width blank -padded comparison semantics. - -Unsupported values of the TYPE attribute generate a warning. - - -=head2 Stored Procedures - -C<DBD::Pg> does not support stored procedures. - - -=head2 Table Metadata - -C<DBD::Pg> supports the C<table_info()> method. - -The I<pg_attribute> table contains detailed information about all columns -of all the tables in the database, one row per table. - -The I<pg_index> table contains detailed information about all indexes in -the database, one row per index. - -Primary keys are implemented as unique indexes. See I<pg_index> above. - - -=head2 Driver-specific Attributes and Methods - -There are no significant C<DBD::Pg> driver-specific database handle attributes. - -C<DBD::Pg> has the following driver-specific statement handle attributes: - -=over 8 - -=item I<pg_size> - -Returns a reference to an array of integer values for each column. The -integer shows the storage (not display) size of the column in bytes. -Variable length columns are indicated by -1. - -=item I<pg_type> - -Returns a reference to an array of strings for each column. The string -shows the name of the data type. - -=item I<pg_oid_status> - -Returns the OID of the last INSERT command. - -=item I<pg_cmd_status> - -Returns the name of the last command type. Possible types are: INSERT, -DELETE, UPDATE, SELECT. - -=back - - -C<DBD::Pg> has no private methods. - - -=head2 Positioned updates and deletes - -Postgresql does not support positioned updates or deletes. - - -=head2 Differences from the DBI Specification - -C<DBD::Pg> has no significant differences in behavior from the -current DBI specification. - -Note that C<DBD::Pg> does not fully parse the statement until -it's executed. Thus attributes like I<$sth-E<gt>{NUM_OF_FIELDS}> are not -available until after C<$sth-E<gt>execute> has been called. This is valid -behaviour but is important to note when porting applications -originally written for other drivers. - - -=head2 URLs to More Database/Driver Specific Information - - http://www.postgresql.org - - -=head2 Concurrent use of Multiple Handles - -C<DBD::Pg> supports an unlimited number of concurrent database -connections to one or more databases. - -It also supports the preparation and execution of a new statement -handle while still fetching data from another statement handle, -provided it is -associated with the same database handle. - - -=head2 Other Significant Database or Driver Features - -Postgres offers substantial additional power by incorporating the -following four additional basic concepts in such a way that users can -easily extend the system: classes, inheritance, types, and functions. - -Other features provide additional power and flexibility: constraints, -triggers, rules, transaction integrity, procedural languages, and large objects. - -It's also free Open Source Software with an active community of developers. - -=cut - -# This driver summary for DBD::Pg is Copyright (c) 1999 Tim Bunce -# and Edmund Mergl. -# $Id: dbd-pg.pod,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.c b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.c deleted file mode 100644 index 467d168..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.c +++ /dev/null @@ -1,1725 +0,0 @@ - -/* - $Id: dbdimp.c,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - Copyright (c) 1997,1998,1999,2000 Edmund Mergl - Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. - -*/ - - -/* - hard-coded OIDs: (here we need the postgresql types) - pg_sql_type() 1042 (bpchar), 1043 (varchar) - ddb_st_fetch() 1042 (bpchar), 16 (bool) - ddb_preparse() 1043 (varchar) - pgtype_bind_ok() -*/ - -#include "Pg.h" - -/* XXX DBI should provide a better version of this */ -#define IS_DBI_HANDLE(h) (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && SvRMAGICAL(SvRV(h)) && (SvMAGIC(SvRV(h)))->mg_type == 'P') - -DBISTATE_DECLARE; - - -static void dbd_preparse (imp_sth_t *imp_sth, char *statement); - - -void -dbd_init (dbistate) - dbistate_t *dbistate; -{ - DBIS = dbistate; -} - - -int -dbd_discon_all (drh, imp_drh) - SV *drh; - imp_drh_t *imp_drh; -{ - dTHR; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_discon_all\n"); } - - /* The disconnect_all concept is flawed and needs more work */ - if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) { - sv_setiv(DBIc_ERR(imp_drh), (IV)1); - sv_setpv(DBIc_ERRSTR(imp_drh), - (char*)"disconnect_all not implemented"); - DBIh_EVENT2(drh, ERROR_event, - DBIc_ERR(imp_drh), DBIc_ERRSTR(imp_drh)); - return FALSE; - } - if (perl_destruct_level) { - perl_destruct_level = 0; - } - return FALSE; -} - - -/* Database specific error handling. */ - -void -pg_error (h, error_num, error_msg) - SV *h; - int error_num; - char *error_msg; -{ - D_imp_xxh(h); - - sv_setiv(DBIc_ERR(imp_xxh), (IV)error_num); /* set err early */ - sv_setpv(DBIc_ERRSTR(imp_xxh), (char*)error_msg); - DBIh_EVENT2(h, ERROR_event, DBIc_ERR(imp_xxh), DBIc_ERRSTR(imp_xxh)); - if (dbis->debug >= 2) { fprintf(DBILOGFP, "%s error %d recorded: %s\n", error_msg, error_num, SvPV(DBIc_ERRSTR(imp_xxh),na)); } -} - -static int -pgtype_bind_ok (dbtype) - int dbtype; -{ - /* basically we support types that can be returned as strings */ - switch(dbtype) { - case 16: /* bool */ - case 18: /* char */ - case 20: /* int8 */ - case 21: /* int2 */ - case 23: /* int4 */ - case 25: /* text */ - case 26: /* oid */ - case 700: /* float4 */ - case 701: /* float8 */ - case 702: /* abstime */ - case 703: /* reltime */ - case 704: /* tinterval */ - case 1042: /* bpchar */ - case 1043: /* varchar */ - case 1082: /* date */ - case 1083: /* time */ - case 1184: /* datetime */ - case 1186: /* timespan */ - case 1296: /* timestamp */ - return 1; - } - return 0; -} - - -/* ================================================================== */ - -int -pg_db_login (dbh, imp_dbh, dbname, uid, pwd) - SV *dbh; - imp_dbh_t *imp_dbh; - char *dbname; - char *uid; - char *pwd; -{ - dTHR; - - char *conn_str; - char *src; - char *dest; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "pg_db_login\n"); } - - /* build connect string */ - /* DBD-Pg syntax: 'dbname=dbname;host=host;port=port' */ - /* pgsql syntax: 'dbname=dbname host=host port=port user=uid password=pwd' */ - - conn_str = (char *)malloc(strlen(dbname) + strlen(uid) + strlen(pwd) + 16 + 1); - if (! conn_str) { - return 0; - } - - src = dbname; - dest = conn_str; - while (*src) { - if (*src != ';') { - *dest++ = *src++; - continue; - } - *dest++ = ' '; - src++; - } - *dest = '\0'; - - if (strlen(uid)) { - strcat(conn_str, " user="); - strcat(conn_str, uid); - } - if (strlen(uid) && strlen(pwd)) { - strcat(conn_str, " password="); - strcat(conn_str, pwd); - } - - if (dbis->debug >= 2) { fprintf(DBILOGFP, "pg_db_login: conn_str = >%s<\n", conn_str); } - - /* make a connection to the database */ - imp_dbh->conn = PQconnectdb(conn_str); - free(conn_str); - - /* check to see that the backend connection was successfully made */ - if (PQstatus(imp_dbh->conn) != CONNECTION_OK) { - pg_error(dbh, PQstatus(imp_dbh->conn), PQerrorMessage(imp_dbh->conn)); - PQfinish(imp_dbh->conn); - return 0; - } - - imp_dbh->init_commit = 1; /* initialize AutoCommit */ - imp_dbh->pg_auto_escape = 1; /* initialize pg_auto_escape */ - - DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */ - DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */ - return 1; -} - - -int -dbd_db_ping (dbh) - SV *dbh; -{ - char id; - D_imp_dbh(dbh); - PGresult* result; - ExecStatusType status; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_ping\n"); } - - result = PQexec(imp_dbh->conn, " "); - status = result ? PQresultStatus(result) : -1; - - if (PGRES_EMPTY_QUERY != status) { - return 0; - } - - return 1; -} - - -int -dbd_db_commit (dbh, imp_dbh) - SV *dbh; - imp_dbh_t *imp_dbh; -{ - PGresult* result = 0; - ExecStatusType status; - int retval = 1; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_commit\n"); } - - /* no commit if AutoCommit = on */ - if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) { - return 0; - } - - /* execute commit */ - result = PQexec(imp_dbh->conn, "commit"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - - /* check result */ - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "commit failed\n"); - return 0; - } - - /* start new transaction if AutoCommit = off */ - if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) { - result = PQexec(imp_dbh->conn, "begin"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "begin failed\n"); - return 0; - } - } - - return retval; -} - - -int -dbd_db_rollback (dbh, imp_dbh) - SV *dbh; - imp_dbh_t *imp_dbh; -{ - PGresult* result = 0; - ExecStatusType status; - int retval = 1; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_rollback\n"); } - - /* no rollback if AutoCommit = on */ - if (DBIc_has(imp_dbh, DBIcf_AutoCommit) != FALSE) { - return 0; - } - - /* execute rollback */ - result = PQexec(imp_dbh->conn, "rollback"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - - /* check result */ - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "rollback failed\n"); - return 0; - } - - /* start new transaction if AutoCommit = off */ - if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) { - result = PQexec(imp_dbh->conn, "begin"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "begin failed\n"); - return 0; - } - } - - return retval; -} - - -int -dbd_db_disconnect (dbh, imp_dbh) - SV *dbh; - imp_dbh_t *imp_dbh; -{ - dTHR; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_disconnect\n"); } - - /* We assume that disconnect will always work */ - /* since most errors imply already disconnected. */ - DBIc_ACTIVE_off(imp_dbh); - - /* rollback if AutoCommit = off */ - if (DBIc_has(imp_dbh, DBIcf_AutoCommit) == FALSE) { - PGresult* result = 0; - ExecStatusType status; - result = PQexec(imp_dbh->conn, "rollback"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "rollback failed\n"); - return 0; - } - if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_disconnect: AutoCommit=off -> rollback\n"); } - } - - PQfinish(imp_dbh->conn); - - /* We don't free imp_dbh since a reference still exists */ - /* The DESTROY method is the only one to 'free' memory. */ - /* Note that statement objects may still exists for this dbh! */ - return 1; -} - - -void -dbd_db_destroy (dbh, imp_dbh) - SV *dbh; - imp_dbh_t *imp_dbh; -{ - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_destroy\n"); } - - if (DBIc_ACTIVE(imp_dbh)) { - dbd_db_disconnect(dbh, imp_dbh); - } - - /* Nothing in imp_dbh to be freed */ - DBIc_IMPSET_off(imp_dbh); -} - - -int -dbd_db_STORE_attrib (dbh, imp_dbh, keysv, valuesv) - SV *dbh; - imp_dbh_t *imp_dbh; - SV *keysv; - SV *valuesv; -{ - STRLEN kl; - char *key = SvPV(keysv,kl); - int newval = SvTRUE(valuesv); - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_STORE\n"); } - - if (kl==10 && strEQ(key, "AutoCommit")) { - int oldval = DBIc_has(imp_dbh, DBIcf_AutoCommit); - DBIc_set(imp_dbh, DBIcf_AutoCommit, newval); - if (oldval == FALSE && newval != FALSE && imp_dbh->init_commit) { - /* do nothing, fall through */ - if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: initialize AutoCommit to on\n"); } - } else if (oldval == FALSE && newval != FALSE) { - /* commit any outstanding changes */ - PGresult* result = 0; - ExecStatusType status; - result = PQexec(imp_dbh->conn, "commit"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "commit failed\n"); - return 0; - } - if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to on: commit\n"); } - } else if ((oldval != FALSE && newval == FALSE) || (oldval == FALSE && newval == FALSE && imp_dbh->init_commit)) { - /* start new transaction */ - PGresult* result = 0; - ExecStatusType status; - result = PQexec(imp_dbh->conn, "begin"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(dbh, status, "begin failed\n"); - return 0; - } - if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_db_STORE: switch AutoCommit to off: begin\n"); } - } - /* only needed once */ - imp_dbh->init_commit = 0; - return 1; - } else if (kl==14 && strEQ(key, "pg_auto_escape")) { - imp_dbh->pg_auto_escape = newval; - } else { - return 0; - } -} - - -SV * -dbd_db_FETCH_attrib (dbh, imp_dbh, keysv) - SV *dbh; - imp_dbh_t *imp_dbh; - SV *keysv; -{ - STRLEN kl; - char *key = SvPV(keysv,kl); - SV *retsv = Nullsv; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_db_FETCH\n"); } - - if (kl==10 && strEQ(key, "AutoCommit")) { - retsv = boolSV(DBIc_has(imp_dbh, DBIcf_AutoCommit)); - } else if (kl==14 && strEQ(key, "pg_auto_escape")) { - retsv = newSViv((IV)imp_dbh->pg_auto_escape); - } else if (kl==11 && strEQ(key, "pg_INV_READ")) { - retsv = newSViv((IV)INV_READ); - } else if (kl==12 && strEQ(key, "pg_INV_WRITE")) { - retsv = newSViv((IV)INV_WRITE); - } - - if (!retsv) { - return Nullsv; - } - if (retsv == &sv_yes || retsv == &sv_no) { - return retsv; /* no need to mortalize yes or no */ - } - return sv_2mortal(retsv); -} - - -/* driver specific functins */ - - -int -pg_db_lo_open (dbh, lobjId, mode) - SV *dbh; - unsigned int lobjId; - int mode; -{ - D_imp_dbh(dbh); - return lo_open(imp_dbh->conn, lobjId, mode); -} - - -int -pg_db_lo_close (dbh, fd) - SV *dbh; - int fd; -{ - D_imp_dbh(dbh); - return lo_close(imp_dbh->conn, fd); -} - - -int -pg_db_lo_read (dbh, fd, buf, len) - SV *dbh; - int fd; - char *buf; - int len; -{ - D_imp_dbh(dbh); - return lo_read(imp_dbh->conn, fd, buf, len); -} - - -int -pg_db_lo_write (dbh, fd, buf, len) - SV *dbh; - int fd; - char *buf; - int len; -{ - D_imp_dbh(dbh); - return lo_write(imp_dbh->conn, fd, buf, len); -} - - -int -pg_db_lo_lseek (dbh, fd, offset, whence) - SV *dbh; - int fd; - int offset; - int whence; -{ - D_imp_dbh(dbh); - return lo_lseek(imp_dbh->conn, fd, offset, whence); -} - - -unsigned int -pg_db_lo_creat (dbh, mode) - SV *dbh; - int mode; -{ - D_imp_dbh(dbh); - return lo_creat(imp_dbh->conn, mode); -} - - -int -pg_db_lo_tell (dbh, fd) - SV *dbh; - int fd; -{ - D_imp_dbh(dbh); - return lo_tell(imp_dbh->conn, fd); -} - - -int -pg_db_lo_unlink (dbh, lobjId) - SV *dbh; - unsigned int lobjId; -{ - D_imp_dbh(dbh); - return lo_unlink(imp_dbh->conn, lobjId); -} - - -unsigned int -pg_db_lo_import (dbh, filename) - SV *dbh; - char *filename; -{ - D_imp_dbh(dbh); - return lo_import(imp_dbh->conn, filename); -} - - -int -pg_db_lo_export (dbh, lobjId, filename) - SV *dbh; - unsigned int lobjId; - char *filename; -{ - D_imp_dbh(dbh); - return lo_export(imp_dbh->conn, lobjId, filename); -} - - -int -pg_db_putline (dbh, buffer) - SV *dbh; - char *buffer; -{ - D_imp_dbh(dbh); - return PQputline(imp_dbh->conn, buffer); -} - - -int -pg_db_getline (dbh, buffer, length) - SV *dbh; - char *buffer; - int length; -{ - D_imp_dbh(dbh); - return PQgetline(imp_dbh->conn, buffer, length); -} - - -int -pg_db_endcopy (dbh) - SV *dbh; -{ - D_imp_dbh(dbh); - return PQendcopy(imp_dbh->conn); -} - - -/* ================================================================== */ - - -int -dbd_st_prepare (sth, imp_sth, statement, attribs) - SV *sth; - imp_sth_t *imp_sth; - char *statement; - SV *attribs; -{ - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_prepare: statement = >%s<\n", statement); } - - /* scan statement for '?', ':1' and/or ':foo' style placeholders */ - dbd_preparse(imp_sth, statement); - - /* initialize new statement handle */ - imp_sth->result = 0; - imp_sth->cur_tuple = 0; - - DBIc_IMPSET_on(imp_sth); - return 1; -} - - -static void -dbd_preparse (imp_sth, statement) - imp_sth_t *imp_sth; - char *statement; -{ - bool in_literal = FALSE; - char in_comment = '\0'; - char *src, *start, *dest; - phs_t phs_tpl; - SV *phs_sv; - int idx=0; - char *style="", *laststyle=Nullch; - STRLEN namelen; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_preparse: statement = >%s<\n", statement); } - - /* allocate room for copy of statement with spare capacity */ - /* for editing '?' or ':1' into ':p1'. */ - imp_sth->statement = (char*)safemalloc(strlen(statement) * 3 + 1); - - /* initialise phs ready to be cloned per placeholder */ - memset(&phs_tpl, 0, sizeof(phs_tpl)); - phs_tpl.ftype = 1043; /* VARCHAR */ - - src = statement; - dest = imp_sth->statement; - while(*src) { - - if (in_comment) { - /* SQL-style and C++-style */ - if ((in_comment == '-' || in_comment == '/') && *src == '\n') { - in_comment = '\0'; - } - /* C-style */ - else if (in_comment == '*' && *src == '*' && *(src+1) == '/') { - *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */ - in_comment = '\0'; - } - *dest++ = *src++; - continue; - } - - if (in_literal) { - /* check if literal ends but keep quotes in literal */ - if (*src == in_literal && *(src-1) != '\\') { - in_literal = 0; - } - *dest++ = *src++; - continue; - } - - /* Look for comments: SQL-style or C++-style or C-style */ - if ((*src == '-' && *(src+1) == '-') || - (*src == '/' && *(src+1) == '/') || - (*src == '/' && *(src+1) == '*')) - { - in_comment = *(src+1); - /* We know *src & the next char are to be copied, so do */ - /* it. In the case of C-style comments, it happens to */ - /* help us avoid slash-asterisk-slash oddities. */ - *dest++ = *src++; - *dest++ = *src++; - continue; - } - - /* check if no placeholders */ - if (*src != ':' && *src != '?') { - if (*src == '\'' || *src == '"') { - in_literal = *src; - } - *dest++ = *src++; - continue; - } - - /* check for cast operator */ - if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) { - *dest++ = *src++; - continue; - } - - /* only here for : or ? outside of a comment or literal and no cast */ - - start = dest; /* save name inc colon */ - *dest++ = *src++; - if (*start == '?') { /* X/Open standard */ - sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */ - dest = start+strlen(start); - style = "?"; - - } else if (isDIGIT(*src)) { /* ':1' */ - idx = atoi(src); - *dest++ = 'p'; /* ':1'->':p1' */ - if (idx <= 0) { - croak("Placeholder :%d invalid, placeholders must be >= 1", idx); - } - while(isDIGIT(*src)) { - *dest++ = *src++; - } - style = ":1"; - - } else if (isALNUM(*src)) { /* ':foo' */ - while(isALNUM(*src)) { /* includes '_' */ - *dest++ = *src++; - } - style = ":foo"; - } else { /* perhaps ':=' PL/SQL construct */ - continue; - } - *dest = '\0'; /* handy for debugging */ - namelen = (dest-start); - if (laststyle && style != laststyle) { - croak("Can't mix placeholder styles (%s/%s)",style,laststyle); - } - laststyle = style; - if (imp_sth->all_params_hv == NULL) { - imp_sth->all_params_hv = newHV(); - } - phs_tpl.sv = &sv_undef; - phs_sv = newSVpv((char*)&phs_tpl, sizeof(phs_tpl)+namelen+1); - hv_store(imp_sth->all_params_hv, start, namelen, phs_sv, 0); - strcpy( ((phs_t*)(void*)SvPVX(phs_sv))->name, start); - } - *dest = '\0'; - if (imp_sth->all_params_hv) { - DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv); - if (dbis->debug >= 2) { fprintf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); } - } -} - - -static int -pg_sql_type (imp_sth, name, sql_type) - imp_sth_t *imp_sth; - char *name; - int sql_type; -{ - switch (sql_type) { - case SQL_CHAR: - return 1042; /* bpchar */ - case SQL_NUMERIC: - return 700; /* float4 */ - case SQL_DECIMAL: - return 700; /* float4 */ - case SQL_INTEGER: - return 23; /* int4 */ - case SQL_SMALLINT: - return 21; /* int2 */ - case SQL_FLOAT: - return 700; /* float4 */ - case SQL_REAL: - return 701; /* float8 */ - case SQL_DOUBLE: - return 20; /* int8 */ - case SQL_VARCHAR: - return 1043; /* varchar */ - default: - if (DBIc_WARN(imp_sth) && imp_sth && name) { - warn("SQL type %d for '%s' is not fully supported, bound as VARCHAR instead"); - } - return pg_sql_type(imp_sth, name, SQL_VARCHAR); - } -} - - -static int -dbd_rebind_ph (sth, imp_sth, phs) - SV *sth; - imp_sth_t *imp_sth; - phs_t *phs; -{ - STRLEN value_len; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_rebind\n"); } - - /* convert to a string ASAP */ - if (!SvPOK(phs->sv) && SvOK(phs->sv)) { - sv_2pv(phs->sv, &na); - } - - if (dbis->debug >= 2) { - char *val = neatsvpv(phs->sv,0); - fprintf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val); - if (SvOK(phs->sv)) { - fprintf(DBILOGFP, "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen); - } else { - fprintf(DBILOGFP, "NULL, "); - } - fprintf(DBILOGFP, "ptype %d, otype %d%s)\n", (int)SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" : ""); - } - - /* At the moment we always do sv_setsv() and rebind. */ - /* Later we may optimise this so that more often we can */ - /* just copy the value & length over and not rebind. */ - - if (phs->is_inout) { /* XXX */ - if (SvREADONLY(phs->sv)) { - croak(no_modify); - } - /* phs->sv _is_ the real live variable, it may 'mutate' later */ - /* pre-upgrade high to reduce risk of SvPVX realloc/move */ - (void)SvUPGRADE(phs->sv, SVt_PVNV); - /* ensure room for result, 28 is magic number (see sv_2pv) */ - SvGROW(phs->sv, (phs->maxlen < 28) ? 28 : phs->maxlen+1); - } - else { - /* phs->sv is copy of real variable, upgrade to at least string */ - (void)SvUPGRADE(phs->sv, SVt_PV); - } - - /* At this point phs->sv must be at least a PV with a valid buffer, */ - /* even if it's undef (null) */ - /* Here we set phs->progv, phs->indp, and value_len. */ - if (SvOK(phs->sv)) { - phs->progv = SvPV(phs->sv, value_len); - phs->indp = 0; - } - else { /* it's null but point to buffer in case it's an out var */ - phs->progv = SvPVX(phs->sv); - phs->indp = -1; - value_len = 0; - } - phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */ - phs->maxlen = SvLEN(phs->sv)-1; /* avail buffer space */ - if (phs->maxlen < 0) { /* can happen with nulls */ - phs->maxlen = 0; - } - - phs->alen = value_len + phs->alen_incnull; - - imp_sth->all_params_len += SvOK(phs->sv) ? phs->alen : 4; /* NULL */ - - if (dbis->debug >= 3) { - fprintf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d)\n", - phs->name, - (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen), - (phs->progv) ? phs->progv : "", - (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp); - } - - return 1; -} - - -int -dbd_bind_ph (sth, imp_sth, ph_namesv, newvalue, sql_type, attribs, is_inout, maxlen) - SV *sth; - imp_sth_t *imp_sth; - SV *ph_namesv; - SV *newvalue; - IV sql_type; - SV *attribs; - int is_inout; - IV maxlen; -{ - SV **phs_svp; - STRLEN name_len; - char *name; - char namebuf[30]; - phs_t *phs; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_bind_ph\n"); } - - /* check if placeholder was passed as a number */ - - if (SvGMAGICAL(ph_namesv)) { /* eg if from tainted expression */ - mg_get(ph_namesv); - } - if (!SvNIOKp(ph_namesv)) { - name = SvPV(ph_namesv, name_len); - } - if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) { - sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv)); - name = namebuf; - name_len = strlen(name); - } - assert(name != Nullch); - - if (SvTYPE(newvalue) > SVt_PVLV) { /* hook for later array logic */ - croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0)); - } - if (SvROK(newvalue) && !IS_DBI_HANDLE(newvalue)) { - /* dbi handle allowed for cursor variables */ - croak("Can't bind a reference (%s)", neatsvpv(newvalue,0)); - } - if (SvTYPE(newvalue) == SVt_PVLV && is_inout) { /* may allow later */ - croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)"); - } - - if (dbis->debug >= 2) { - fprintf(DBILOGFP, " bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type); - if (is_inout) { - fprintf(DBILOGFP, ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen); - } - if (attribs) { - fprintf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0)); - } - fprintf(DBILOGFP, ")\n"); - } - - phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0); - if (phs_svp == NULL) { - croak("Can't bind unknown placeholder '%s' (%s)", name, neatsvpv(ph_namesv,0)); - } - phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */ - - if (phs->sv == &sv_undef) { /* first bind for this placeholder */ - phs->ftype = 1043; /* our default type VARCHAR */ - phs->is_inout = is_inout; - if (is_inout) { - /* phs->sv assigned in the code below */ - ++imp_sth->has_inout_params; - /* build array of phs's so we can deal with out vars fast */ - if (!imp_sth->out_params_av) { - imp_sth->out_params_av = newAV(); - } - av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp)); - } - - if (attribs) { /* only look for pg_type on first bind of var */ - SV **svp; - /* Setup / Clear attributes as defined by attribs. */ - /* XXX If attribs is EMPTY then reset attribs to default? */ - if ( (svp = hv_fetch((HV*)SvRV(attribs), "pg_type", 7, 0)) != NULL) { - int pg_type = SvIV(*svp); - if (!pgtype_bind_ok(pg_type)) { - croak("Can't bind %s, pg_type %d not supported by DBD::Pg", phs->name, pg_type); - } - if (sql_type) { - croak("Can't specify both TYPE (%d) and pg_type (%d) for %s", sql_type, pg_type, phs->name); - } - phs->ftype = pg_type; - } - } - if (sql_type) { - phs->ftype = pg_sql_type(imp_sth, phs->name, sql_type); - } - } /* was first bind for this placeholder */ - - /* check later rebinds for any changes */ - else if (is_inout || phs->is_inout) { - croak("Can't rebind or change param %s in/out mode after first bind (%d => %d)", phs->name, phs->is_inout , is_inout); - } - else if (sql_type && phs->ftype != pg_sql_type(imp_sth, phs->name, sql_type)) { - croak("Can't change TYPE of param %s to %d after initial bind", phs->name, sql_type); - } - - phs->maxlen = maxlen; /* 0 if not inout */ - - if (!is_inout) { /* normal bind to take a (new) copy of current value */ - if (phs->sv == &sv_undef) { /* (first time bind) */ - phs->sv = newSV(0); - } - sv_setsv(phs->sv, newvalue); - } else if (newvalue != phs->sv) { - if (phs->sv) { - SvREFCNT_dec(phs->sv); - } - phs->sv = SvREFCNT_inc(newvalue); /* point to live var */ - } - - return dbd_rebind_ph(sth, imp_sth, phs); -} - - -int -dbd_st_execute (sth, imp_sth) /* <= -2:error, >=0:ok row count, (-1=unknown count) */ - SV *sth; - imp_sth_t *imp_sth; -{ - dTHR; - - D_imp_dbh_from_sth; - ExecStatusType status = -1; - char *cmdStatus; - char *cmdTuples; - char *statement; - int ret = -2; - int num_fields; - int i; - int len; - bool in_literal = FALSE; - char in_comment = '\0'; - char *src; - char *dest; - char *val; - char namebuf[30]; - phs_t *phs; - SV **svp; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_execute\n"); } - - /* - here we get the statement from the statement handle where - it has been stored when creating a blank sth during prepare - svp = hv_fetch((HV *)SvRV(sth), "Statement", 9, FALSE); - statement = SvPV(*svp, na); - */ - - statement = imp_sth->statement; - if (! statement) { - /* are we prepared ? */ - pg_error(sth, -1, "statement not prepared\n"); - return -2; - } - - /* do we have input parameters ? */ - if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) { - /* we have to allocate some additional memory for possible escaping quotes and backslashes */ - /* Worst case is all character must be escaped and must be quoted */ - int max_len = imp_sth->all_params_len * 2 + DBIc_NUM_PARAMS(imp_sth) * 2 + 1; - statement = (char*)safemalloc(strlen(imp_sth->statement) + max_len ); - dest = statement; - src = imp_sth->statement; - /* scan statement for ':p1' style placeholders */ - while(*src) { - - if (in_comment) { - /* SQL-style and C++-style */ - if ((in_comment == '-' || in_comment == '/') && *src == '\n') { - in_comment = '\0'; - } - /* C-style */ - else if (in_comment == '*' && *src == '*' && *(src+1) == '/') { - *dest++ = *src++; /* avoids asterisk-slash-asterisk issues */ - in_comment = '\0'; - } - *dest++ = *src++; - continue; - } - - if (in_literal) { - /* check if literal ends but keep quotes in literal */ - if (*src == in_literal && *(src-1) != '\\') { - in_literal = 0; - } - *dest++ = *src++; - continue; - } - - /* Look for comments: SQL-style or C++-style or C-style */ - if ((*src == '-' && *(src+1) == '-') || - (*src == '/' && *(src+1) == '/') || - (*src == '/' && *(src+1) == '*')) - { - in_comment = *(src+1); - /* We know *src & the next char are to be copied, so do */ - /* it. In the case of C-style comments, it happens to */ - /* help us avoid slash-asterisk-slash oddities. */ - *dest++ = *src++; - *dest++ = *src++; - continue; - } - - /* check if no placeholders */ - if (*src != ':' && *src != '?') { - if (*src == '\'' || *src == '"') { - in_literal = *src; - } - *dest++ = *src++; - continue; - } - - /* check for cast operator */ - if (*src == ':' && (*(src-1) == ':' || *(src+1) == ':')) { - *dest++ = *src++; - continue; - } - - - i = 0; - namebuf[i++] = *src++; /* ':' */ - namebuf[i++] = *src++; /* 'p' */ - - while (isDIGIT(*src) && i < (sizeof(namebuf)-1) ) { - namebuf[i++] = *src++; - } - if ( i == (sizeof(namebuf) - 1)) { - pg_error(sth, -1, "namebuf buffer overrun\n"); - return -2; - } - namebuf[i] = '\0'; - svp = hv_fetch(imp_sth->all_params_hv, namebuf, i, 0); - if (svp == NULL) { - pg_error(sth, -1, "parameter unknown\n"); - return -2; - } - /* get attribute */ - phs = (phs_t*)(void*)SvPVX(*svp); - /* replace undef with NULL */ - if(!SvOK(phs->sv)) { - val = "NULL"; - len = 4; - } else { - val = SvPV(phs->sv, len); - } - /* quote string attribute */ - if(!SvNIOK(phs->sv) && SvOK(phs->sv) && phs->ftype > 1000) { /* avoid quoting NULL, tpf: bind_param as numeric */ - *dest++ = '\''; - } - while (len--) { - if (imp_dbh->pg_auto_escape) { - /* escape quote */ - if (*val == '\'') { - *dest++ = '\''; - } - /* escape backslash except for octal presentation */ - if (*val == '\\' && !(isdigit(*(val+1)) && isdigit(*(val+2)) && isdigit(*(val+3))) ) { - *dest++ = '\\'; - } - } - /* copy attribute to statement */ - *dest++ = *val++; - } - /* quote string attribute */ - if(!SvNIOK(phs->sv) && SvOK(phs->sv) && phs->ftype > 1000) { /* avoid quoting NULL, tpf: bind_param as numeric */ - *dest++ = '\''; - } - } - *dest = '\0'; - } - - if (dbis->debug >= 2) { fprintf(DBILOGFP, "dbd_st_execute: statement = >%s<\n", statement); } - - /* clear old result (if any) */ - if (imp_sth->result) { - PQclear(imp_sth->result); - } - - /* execute statement */ - imp_sth->result = PQexec(imp_dbh->conn, statement); - - /* free statement string in case of input parameters */ - if ((int)DBIc_NUM_PARAMS(imp_sth) > 0) { - Safefree(statement); - } - - /* check status */ - status = imp_sth->result ? PQresultStatus(imp_sth->result) : -1; - cmdStatus = imp_sth->result ? (char *)PQcmdStatus(imp_sth->result) : ""; - cmdTuples = imp_sth->result ? (char *)PQcmdTuples(imp_sth->result) : ""; - - if (PGRES_TUPLES_OK == status) { - /* select statement */ - num_fields = PQnfields(imp_sth->result); - imp_sth->cur_tuple = 0; - DBIc_NUM_FIELDS(imp_sth) = num_fields; - DBIc_ACTIVE_on(imp_sth); - ret = PQntuples(imp_sth->result); - } else if (PGRES_COMMAND_OK == status) { - /* non-select statement */ - if (! strncmp(cmdStatus, "DELETE", 6) || ! strncmp(cmdStatus, "INSERT", 6) || ! strncmp(cmdStatus, "UPDATE", 6)) { - ret = atoi(cmdTuples); - } else { - ret = -1; - } - } else if (PGRES_COPY_OUT == status || PGRES_COPY_IN == status) { - /* Copy Out/In data transfer in progress */ - ret = -1; - } else { - pg_error(sth, status, PQerrorMessage(imp_dbh->conn)); - ret = -2; - } - - /* store the number of affected rows */ - imp_sth->rows = ret; - - return ret; -} - - -AV * -dbd_st_fetch (sth, imp_sth) - SV *sth; - imp_sth_t *imp_sth; -{ - int num_fields; - int i; - AV *av; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_fetch\n"); } - - /* Check that execute() was executed sucessfully */ - if ( !DBIc_ACTIVE(imp_sth) ) { - pg_error(sth, 1, "no statement executing\n"); - return Nullav; - } - - if ( imp_sth->cur_tuple == PQntuples(imp_sth->result) ) { - imp_sth->cur_tuple = 0; - return Nullav; /* we reached the last tuple */ - } - - av = DBIS->get_fbav(imp_sth); - num_fields = AvFILL(av)+1; - - for(i = 0; i < num_fields; ++i) { - - SV *sv = AvARRAY(av)[i]; - if (PQgetisnull(imp_sth->result, imp_sth->cur_tuple, i)) { - sv_setsv(sv, &sv_undef); - } else { - char *val = (char*)PQgetvalue(imp_sth->result, imp_sth->cur_tuple, i); - int type = PQftype(imp_sth->result, i); /* hopefully these hard coded values will not change */ - if (16 == type) { - *val = (*val == 'f') ? '0' : '1'; /* bool: translate postgres into perl */ - } - if (1042 == type && DBIc_has(imp_sth,DBIcf_ChopBlanks)) { - int len = strlen(val); - char *str = val; - while((len > 0) && (str[len-1] == ' ')) { - len--; - } - val[len] = '\0'; - } - sv_setpv(sv, val); - } - } - - imp_sth->cur_tuple += 1; - - return av; -} - - -int -dbd_st_blob_read (sth, imp_sth, lobjId, offset, len, destrv, destoffset) - SV *sth; - imp_sth_t *imp_sth; - int lobjId; - long offset; - long len; - SV *destrv; - long destoffset; -{ - D_imp_dbh_from_sth; - int ret, lobj_fd, nbytes, nread; - PGresult* result; - ExecStatusType status; - SV *bufsv; - char *tmp; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_blob_read\n"); } - /* safety check */ - if (lobjId <= 0) { - pg_error(sth, -1, "dbd_st_blob_read: lobjId <= 0"); - return 0; - } - if (offset < 0) { - pg_error(sth, -1, "dbd_st_blob_read: offset < 0"); - return 0; - } - if (len < 0) { - pg_error(sth, -1, "dbd_st_blob_read: len < 0"); - return 0; - } - if (! SvROK(destrv)) { - pg_error(sth, -1, "dbd_st_blob_read: destrv not a reference"); - return 0; - } - if (destoffset < 0) { - pg_error(sth, -1, "dbd_st_blob_read: destoffset < 0"); - return 0; - } - - /* dereference destination and ensure it's writable string */ - bufsv = SvRV(destrv); - if (! destoffset) { - sv_setpvn(bufsv, "", 0); - } - - /* execute begin - result = PQexec(imp_dbh->conn, "begin"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(sth, status, PQerrorMessage(imp_dbh->conn)); - return 0; - } - */ - - /* open large object */ - lobj_fd = lo_open(imp_dbh->conn, lobjId, INV_READ); - if (lobj_fd < 0) { - pg_error(sth, -1, PQerrorMessage(imp_dbh->conn)); - return 0; - } - - /* seek on large object */ - if (offset > 0) { - ret = lo_lseek(imp_dbh->conn, lobj_fd, offset, SEEK_SET); - if (ret < 0) { - pg_error(sth, -1, PQerrorMessage(imp_dbh->conn)); - return 0; - } - } - - /* read from large object */ - nread = 0; - SvGROW(bufsv, destoffset + nread + BUFSIZ + 1); - tmp = (SvPVX(bufsv)) + destoffset + nread; - while ((nbytes = lo_read(imp_dbh->conn, lobj_fd, tmp, BUFSIZ)) > 0) { - nread += nbytes; - tmp = (SvPVX(bufsv)) + destoffset + nread; - /* break if user wants only a specified chunk */ - if (len > 0 && nread > len) { - nread = len; - break; - } - SvGROW(bufsv, destoffset + nread + BUFSIZ + 1); - } - - /* terminate string */ - SvCUR_set(bufsv, destoffset + nread); - *SvEND(bufsv) = '\0'; - - /* close large object */ - ret = lo_close(imp_dbh->conn, lobj_fd); - if (ret < 0) { - pg_error(sth, -1, PQerrorMessage(imp_dbh->conn)); - return 0; - } - - /* execute end - result = PQexec(imp_dbh->conn, "end"); - status = result ? PQresultStatus(result) : -1; - PQclear(result); - if (status != PGRES_COMMAND_OK) { - pg_error(sth, status, PQerrorMessage(imp_dbh->conn)); - return 0; - } - */ - - return nread; -} - - -int -dbd_st_rows (sth, imp_sth) - SV *sth; - imp_sth_t *imp_sth; -{ - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_rows\n"); } - - return imp_sth->rows; -} - - -int -dbd_st_finish (sth, imp_sth) - SV *sth; - imp_sth_t *imp_sth; -{ - dTHR; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_finish\n"); } - - if (DBIc_ACTIVE(imp_sth) && imp_sth->result) { - PQclear(imp_sth->result); - imp_sth->result = 0; - imp_sth->rows = 0; - } - - DBIc_ACTIVE_off(imp_sth); - return 1; -} - - -void -dbd_st_destroy (sth, imp_sth) - SV *sth; - imp_sth_t *imp_sth; -{ - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_destroy\n"); } - - /* Free off contents of imp_sth */ - - Safefree(imp_sth->statement); - if (imp_sth->result) { - PQclear(imp_sth->result); - imp_sth->result = 0; - } - - if (imp_sth->out_params_av) - sv_free((SV*)imp_sth->out_params_av); - - if (imp_sth->all_params_hv) { - HV *hv = imp_sth->all_params_hv; - SV *sv; - char *key; - I32 retlen; - hv_iterinit(hv); - while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) { - if (sv != &sv_undef) { - phs_t *phs_tpl = (phs_t*)(void*)SvPVX(sv); - sv_free(phs_tpl->sv); - } - } - sv_free((SV*)imp_sth->all_params_hv); - } - - DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */ -} - - -int -dbd_st_STORE_attrib (sth, imp_sth, keysv, valuesv) - SV *sth; - imp_sth_t *imp_sth; - SV *keysv; - SV *valuesv; -{ - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_STORE\n"); } - - return FALSE; -} - - -SV * -dbd_st_FETCH_attrib (sth, imp_sth, keysv) - SV *sth; - imp_sth_t *imp_sth; - SV *keysv; -{ - STRLEN kl; - char *key = SvPV(keysv,kl); - int i; - SV *retsv = Nullsv; - - if (dbis->debug >= 1) { fprintf(DBILOGFP, "dbd_st_FETCH\n"); } - - if (! imp_sth->result) { - return Nullsv; - } - - i = DBIc_NUM_FIELDS(imp_sth); - - if (kl == 4 && strEQ(key, "NAME")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, newSVpv(PQfname(imp_sth->result, i),0)); - } - } else if ( kl== 4 && strEQ(key, "TYPE")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, newSViv(PQftype(imp_sth->result, i))); - } - } else if (kl==9 && strEQ(key, "PRECISION")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, &sv_undef); - } - } else if (kl==5 && strEQ(key, "SCALE")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, &sv_undef); - } - } else if (kl==8 && strEQ(key, "NULLABLE")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, newSViv(2)); - } - } else if (kl==10 && strEQ(key, "CursorName")) { - retsv = &sv_undef; - } else if (kl==7 && strEQ(key, "pg_size")) { - AV *av = newAV(); - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - av_store(av, i, newSViv(PQfsize(imp_sth->result, i))); - } - } else if (kl==7 && strEQ(key, "pg_type")) { - AV *av = newAV(); - char *type_nam; - retsv = newRV(sv_2mortal((SV*)av)); - while(--i >= 0) { - switch (PQftype(imp_sth->result, i)) { - case 16: - type_nam = "bool"; - break; - case 17: - type_nam = "bytea"; - break; - case 18: - type_nam = "char"; - break; - case 19: - type_nam = "name"; - break; - case 20: - type_nam = "int8"; - break; - case 21: - type_nam = "int2"; - break; - case 22: - type_nam = "int28"; - break; - case 23: - type_nam = "int4"; - break; - case 24: - type_nam = "regproc"; - break; - case 25: - type_nam = "text"; - break; - case 26: - type_nam = "oid"; - break; - case 27: - type_nam = "tid"; - break; - case 28: - type_nam = "xid"; - break; - case 29: - type_nam = "cid"; - break; - case 30: - type_nam = "oid8"; - break; - case 32: - type_nam = "SET"; - break; - case 210: - type_nam = "smgr"; - break; - case 600: - type_nam = "point"; - break; - case 601: - type_nam = "lseg"; - break; - case 602: - type_nam = "path"; - break; - case 603: - type_nam = "box"; - break; - case 604: - type_nam = "polygon"; - break; - case 605: - type_nam = "filename"; - break; - case 628: - type_nam = "line"; - break; - case 629: - type_nam = "_line"; - break; - case 700: - type_nam = "float4"; - break; - case 701: - type_nam = "float8"; - break; - case 702: - type_nam = "abstime"; - break; - case 703: - type_nam = "reltime"; - break; - case 704: - type_nam = "tinterval"; - break; - case 705: - type_nam = "unknown"; - break; - case 718: - type_nam = "circle"; - break; - case 719: - type_nam = "_circle"; - break; - case 790: - type_nam = "money"; - break; - case 791: - type_nam = "_money"; - break; - case 810: - type_nam = "oidint2"; - break; - case 910: - type_nam = "oidint4"; - break; - case 911: - type_nam = "oidname"; - break; - case 1000: - type_nam = "_bool"; - break; - case 1001: - type_nam = "_bytea"; - break; - case 1002: - type_nam = "_char"; - break; - case 1003: - type_nam = "_name"; - break; - case 1005: - type_nam = "_int2"; - break; - case 1006: - type_nam = "_int28"; - break; - case 1007: - type_nam = "_int4"; - break; - case 1008: - type_nam = "_regproc"; - break; - case 1009: - type_nam = "_text"; - break; - case 1028: - type_nam = "_oid"; - break; - case 1010: - type_nam = "_tid"; - break; - case 1011: - type_nam = "_xid"; - break; - case 1012: - type_nam = "_cid"; - break; - case 1013: - type_nam = "_oid8"; - break; - case 1014: - type_nam = "_lock"; - break; - case 1015: - type_nam = "_stub"; - break; - case 1016: - type_nam = "_ref"; - break; - case 1017: - type_nam = "_point"; - break; - case 1018: - type_nam = "_lseg"; - break; - case 1019: - type_nam = "_path"; - break; - case 1020: - type_nam = "_box"; - break; - case 1021: - type_nam = "_float4"; - break; - case 1022: - type_nam = "_float8"; - break; - case 1023: - type_nam = "_abstime"; - break; - case 1024: - type_nam = "_reltime"; - break; - case 1025: - type_nam = "_tinterval"; - break; - case 1026: - type_nam = "_filename"; - break; - case 1027: - type_nam = "_polygon"; - break; - case 1033: - type_nam = "aclitem"; - break; - case 1034: - type_nam = "_aclitem"; - break; - case 1042: - type_nam = "bpchar"; - break; - case 1043: - type_nam = "varchar"; - break; - case 1082: - type_nam = "date"; - break; - case 1083: - type_nam = "time"; - break; - case 1182: - type_nam = "_date"; - break; - case 1183: - type_nam = "_time"; - break; - case 1184: - type_nam = "datetime"; - break; - case 1185: - type_nam = "_datetime"; - break; - case 1186: - type_nam = "timespan"; - break; - case 1187: - type_nam = "_timespan"; - break; - case 1296: - type_nam = "timestamp"; - break; - } - av_store(av, i, newSVpv(type_nam, 0)); - } - } else if (kl==13 && strEQ(key, "pg_oid_status")) { - retsv = newSVpv((char *)PQoidStatus(imp_sth->result), 0); - } else if (kl==13 && strEQ(key, "pg_cmd_status")) { - retsv = newSVpv((char *)PQcmdStatus(imp_sth->result), 0); - } else { - return Nullsv; - } - - return sv_2mortal(retsv); -} - - -/* end of dbdimp.c */ diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.h b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.h deleted file mode 100644 index a953c91..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/dbdimp.h +++ /dev/null @@ -1,73 +0,0 @@ -/* - $Id: dbdimp.h,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - - Copyright (c) 1997,1998,1999,2000 Edmund Mergl - Portions Copyright (c) 1994,1995,1996,1997 Tim Bunce - - You may distribute under the terms of either the GNU General Public - License or the Artistic License, as specified in the Perl README file. - -*/ - - -/* Define drh implementor data structure */ -struct imp_drh_st { - dbih_drc_t com; /* MUST be first element in structure */ -}; - -/* Define dbh implementor data structure */ -struct imp_dbh_st { - dbih_dbc_t com; /* MUST be first element in structure */ - - PGconn * conn; /* connection structure */ - int init_commit; /* initialize AutoCommit */ - int pg_auto_escape; /* initialize AutoEscape */ -}; - -/* Define sth implementor data structure */ -struct imp_sth_st { - dbih_stc_t com; /* MUST be first element in structure */ - - PGresult* result; /* result structure */ - int cur_tuple; /* current tuple */ - int rows; /* number of affected rows */ - - /* Input Details */ - char *statement; /* sql (see sth_scan) */ - HV *all_params_hv; /* all params, keyed by name */ - AV *out_params_av; /* quick access to inout params */ - int pg_pad_empty; /* convert ""->" " when binding */ - int all_params_len; /* length-sum of all params */ - - /* (In/)Out Parameter Details */ - bool has_inout_params; -}; - - -#define sword signed int -#define sb2 signed short -#define ub2 unsigned short - -typedef struct phs_st phs_t; /* scalar placeholder */ - -struct phs_st { /* scalar placeholder EXPERIMENTAL */ - sword ftype; /* external OCI field type */ - - SV *sv; /* the scalar holding the value */ - int sv_type; /* original sv type at time of bind */ - bool is_inout; - - IV maxlen; /* max possible len (=allocated buffer) */ - - /* these will become an array */ - sb2 indp; /* null indicator */ - char *progv; - ub2 arcode; - ub2 alen; /* effective length ( <= maxlen ) */ - - int alen_incnull; /* 0 or 1 if alen should include null */ - char name[1]; /* struct is malloc'd bigger as needed */ -}; - - -/* end of dbdimp.h */ diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/eg/ApacheDBI.pl b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/eg/ApacheDBI.pl deleted file mode 100755 index 2971345..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/eg/ApacheDBI.pl +++ /dev/null @@ -1,70 +0,0 @@ -#!/usr/local/bin/perl - -# $Id: ApacheDBI.pl,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - -# don't forget to create in postgres the user who is running -# the httpd, eg 'createuser nobody' ! -# -# demo script, tested with: -# - PostgreSQL-6.5.2 -# - apache_1.3.9 -# - mod_perl-1.21 -# - perl5.005_03 -# - DBI-1.13 - -use CGI; -use DBI; -use strict; - -my $query = new CGI; - -print $query->header, - $query->start_html(-title=>'A Simple Example'), - $query->startform, - "<CENTER><H3>Testing Module DBI</H3></CENTER>", - "<CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>", - "<TR><TD>Enter the data source: </TD>", - "<TD>", $query->textfield(-name=>'data_source', -size=>40, -default=>'dbi:Pg:dbname=template1'), "</TD>", - "</TR>", - "<TR><TD>Enter the user name: </TD>", - "<TD>", $query->textfield(-name=>'username'), "</TD>", - "</TR>", - "<TR><TD>Enter the password: </TD>", - "<TD>", $query->textfield(-name=>'auth'), "</TD>", - "</TR>", - "<TR><TD>Enter the select command: </TD>", - "<TD>", $query->textfield(-name=>'cmd', -size=>40), "</TD>", - "</TR>", - "</TABLE></CENTER>", - "<CENTER>", $query->submit(-value=>'Submit'), "</CENTER>", - $query->endform; - -if ($query->param) { - - my $data_source = $query->param('data_source'); - my $username = $query->param('username'); - my $auth = $query->param('auth'); - my $cmd = $query->param('cmd'); - my $dbh = DBI->connect($data_source, $username, $auth); - if ($dbh) { - my $sth = $dbh->prepare($cmd); - my $ret = $sth->execute; - if ($ret) { - my($i, $ary_ref); - print "<CENTER><TABLE CELLPADDING=4 CELLSPACING=2 BORDER=1>\n"; - while ($ary_ref = $sth->fetchrow_arrayref) { - print "<TR><TD>", join("</TD><TD>", @$ary_ref), "</TD></TR>\n"; - } - print "</TABLE></CENTER>\n"; - $sth->finish; - } else { - print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n"; - } - $dbh->disconnect; - } else { - print "<CENTER><H2>", $DBI::errstr, "</H2></CENTER>\n"; - } -} - -print $query->end_html; - diff --git a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/test.pl b/monitoring/PerlModules/CPAN/DBD-Pg-0.95/test.pl deleted file mode 100755 index c0cf466..0000000 --- a/monitoring/PerlModules/CPAN/DBD-Pg-0.95/test.pl +++ /dev/null @@ -1,462 +0,0 @@ -#!/usr/local/bin/perl -w - -# $Id: test.pl,v 1.1.1.1 2001-01-12 20:41:07 dparker Exp $ - -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### not tested explicitly -# -# AutoCommit -# commit -# rollback -# Active -# Statement -# attributes -# err -# pg_auto_escape -# quote -# type_info_all -# -######################### We start with some black magic to print on failure. - -BEGIN { $| = 1; } -END {print "test failed\n" unless $loaded;} -use DBI; -$loaded = 1; -use Config; -use strict; - -######################### End of black magic. - -my $os = $^O; -print "OS: $os\n"; - -my $dbmain = "template1"; -my $dbtest = "pgperltest"; - -# optionally add ";host=$remotehost;port=$remoteport" -# or set the environment variable PGHOST -my $dsn_main = "dbi:Pg:dbname=$dbmain"; -my $dsn_test = "dbi:Pg:dbname=$dbtest"; - -my ($dbh0, $dbh, $sth); - -#DBI->trace(3); # make your choice - - -######################### drop, create and connect to test database - -if ($os eq "MSWin32") { - print "DBI->data_sources .......... skipped on $os\n" -} else { - my $data_sources = join(" ", DBI->data_sources('Pg')); - ( $data_sources =~ "$dsn_main" ) - and print "DBI->data_sources .......... ok\n" - or print "DBI->data_sources .......... not ok: $data_sources\n"; -} - -( $dbh0 = DBI->connect("$dsn_main", "", "", { AutoCommit => 1 }) ) - and print "DBI->connect ............... ok\n" - or die "DBI->connect ............... not ok: ", $DBI::errstr; - -my $Name = $dbh0->{Name}; -( "$dbmain" eq $Name ) - and print "\$dbh->{Name} ............... ok\n" - or print "\$dbh->{Name} ............... not ok: $Name\n"; - -( 1 == $dbh0->ping ) - and print "\$dbh->ping ................. ok\n" - or die "\$dbh->ping ................. not ok: ", $DBI::errstr; - -$dbh0->{PrintError} = 0; # do not complain when dropping $dbtest -$dbh0->do("DROP DATABASE $dbtest"); - -( $dbh0->do("CREATE DATABASE $dbtest") ) - and print "\$dbh->do ................... ok\n" - or die "\$dbh->do ................... not ok: ", $DBI::errstr; - -$dbh = DBI->connect("$dsn_test", "", "", { AutoCommit => 1 }) or die $DBI::errstr; - -$dbh->do("Set DateStyle = 'ISO'"); - - -######################### create table - -$dbh->do("CREATE TABLE builtin ( - bool_ bool, - char_ char, - char12_ char(12), - char16_ char(16), - varchar12_ varchar(12), - text_ text, - date_ date, - int4_ int4, - int4a_ int4[], - float8_ float8, - point_ point, - lseg_ lseg, - box_ box - )"); - -$sth = $dbh->table_info; -my @infos = $sth->fetchrow_array; -$sth->finish; -( join(" ", @infos[2,3]) eq q{builtin TABLE} ) - and print "\$dbh->table_info ........... ok\n" - or print "\$dbh->table_info ........... not ok: ", join(" ", @infos), "\n"; - -my @names = $dbh->tables; -( join(" ", @names) eq q{builtin} ) - and print "\$dbh->tables ............... ok\n" - or print "\$dbh->tables ............... not ok: ", join(" ", @names), "\n"; - -my $attrs = $dbh->func('builtin', 'table_attributes'); -( $$attrs[0]{NAME} eq q{varchar12_} ) - and print "\$dbh->pg_table_attributes .. ok\n" - or print "\$dbh->pg_table_attributes .. not ok: ", $$attrs[0]{NAME}, "\n"; -#for (my $i=0; $i<=$#$attrs; $i++) { -# print $$attrs[$i]{NAME}, "\t", -# $$attrs[$i]{TYPE}, "\t", -# $$attrs[$i]{SIZE}, "\t", -# $$attrs[$i]{NOTNULL}, "\t", -# $$attrs[$i]{DEFAULT}, "\t", -# $$attrs[$i]{CONSTRAINT}, "\t", -# $$attrs[$i]{PRIMARY_KEY}, "\n"; -#} - -######################### test various insert methods - -# insert into table with $dbh->do($stmt) - -$dbh->do("INSERT INTO builtin VALUES( - 't', - 'a', - 'Edmund Mergl', - 'quote \\\\ \'\' this', - 'Edmund Mergl', - 'Edmund Mergl', - '1997-03-08', - 1234, - '{1,2,3}', - 1.234, - '(1.0,2.0)', - '((1.0,2.0),(3.0,4.0))', - '((1.0,2.0),(3.0,4.0))' - )") or die $DBI::errstr; - -# insert into table with $dbh->prepare() with placeholders and $dbh->execute(@bind_values) - -( $sth = $dbh->prepare( "INSERT INTO builtin - ( bool_, char_, char12_, char16_, varchar12_, text_, date_, int4_, int4a_, float8_, point_, lseg_, box_ ) - VALUES ( ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? ) - " ) ) - and print "\$dbh->prepare .............. ok\n" - or die "\$dbh->prepare .............. not ok: ", $DBI::errstr; - -( $sth->execute ( - 'f', - 'b', - 'Halli Hallo', - 'but not \164\150\151\163', - 'Halli Hallo', - 'Halli Hallo', - '1995-01-06', - 5678, - '{5,6,7}', - 5.678, - '(4.0,5.0)', - '((4.0,5.0),(6.0,7.0))', - '((4.0,5.0),(6.0,7.0))' - ) ) - and print "\$dbh->execute .............. ok\n" - or die "\$dbh->execute .............. not ok: ", $DBI::errstr; - -$sth->execute ( - 'f', - 'c', - 'Potz Blitz', - 'Potz Blitz', - 'Potz Blitz', - 'Potz Blitz', - '1957-10-05', - 1357, - '{1,3,5}', - 1.357, - '(2.0,7.0)', - '((2.0,7.0),(8.0,3.0))', - '((2.0,7.0),(8.0,3.0))' - ) or die $DBI::errstr; - -# insert into table with $dbh->do($stmt, @bind_values) - -$dbh->do( "INSERT INTO builtin - VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ? )", - {}, - 'y', - 'z', - 'Ene Mene Mu', - 'Ene Mene Mu', - 'Ene Mene Mu', - 'Ene Mene Mu', - '1957-10-14', - 5432, - '{6,7,8}', - 6.789, - '(5.0,6.0)', - '((5.0,6.0),(7.0,8.0))', - '((5.0,6.0),(7.0,8.0))' - ) or die $DBI::errstr; - -my $pg_oid_status = $sth->{pg_oid_status}; -( $pg_oid_status ne '' ) - and print "\$sth->{pg_oid_status} ...... ok\n" - or print "\$sth->{pg_oid_status} ...... not ok: $pg_oid_status\n"; - -my $pg_cmd_status = $sth->{pg_cmd_status}; -( $pg_cmd_status =~ /^INSERT/ ) - and print "\$sth->{pg_cmd_status} ...... ok\n" - or print "\$sth->{pg_cmd_status} ...... not ok: $pg_cmd_status\n"; - -( $sth->finish ) - and print "\$sth->finish ............... ok\n" - or die "\$sth->finish ............... not ok: ", $DBI::errstr; - -######################### test various select methods - -# select from table using input parameters and and various fetchrow methods - -$sth = $dbh->prepare("SELECT * FROM builtin where int4_ < ? + ?") or die $DBI::errstr; - -( $sth->bind_param(1, '4000', DBI::SQL_INTEGER) ) - and print "\$sth->bind_param ........... ok\n" - or die "\$sth->bind_param ........... not ok: ", $DBI::errstr; -$sth->bind_param(2, '6000', DBI::SQL_INTEGER); - -$sth->execute or die $DBI::errstr; - -my @row_ary = $sth->fetchrow_array; -( join(" ", @row_ary) eq q{1 a Edmund Mergl quote \ ' this Edmund Mergl Edmund Mergl 1997-03-08 1234 {1,2,3} 1.234 (1,2) [(1,2),(3,4)] (3,4),(1,2)} ) - and print "\$sth->fetchrow_array ....... ok\n" - or print "\$sth->fetchrow_array ....... not ok: ", join(" ", @row_ary), "\n"; - -my $ary_ref = $sth->fetchrow_arrayref; -( join(" ", @$ary_ref) eq q{0 b Halli Hallo but not this Halli Hallo Halli Hallo 1995-01-06 5678 {5,6,7} 5.678 (4,5) [(4,5),(6,7)] (6,7),(4,5)} ) - and print "\$sth->fetchrow_arrayref .... ok\n" - or print "\$sth->fetchrow_arrayref .... not ok: ", join(" ", @$ary_ref), "\n"; - -my ($key, $val); -my $hash_ref = $sth->fetchrow_hashref; -foreach $key (sort (keys %$hash_ref)) { - $val .= " $$hash_ref{$key}"; -} -($val eq q{ 0 (8,7),(2,3) Potz Blitz Potz Blitz c 1957-10-05 1.357 1357 {1,3,5} [(2,7),(8,3)] (2,7) Potz Blitz Potz Blitz} ) - and print "\$sth->fetchrow_hashref ..... ok\n" - or print "\$sth->fetchrow_hashref ..... not ok: key = $key, val = $val\n"; - -# test various attributes - -my @name = @{$sth->{NAME}}; -( join(" ", @name) eq q{bool_ char_ char12_ char16_ varchar12_ text_ date_ int4_ int4a_ float8_ point_ lseg_ box_} ) - and print "\$sth->{NAME} ............... ok\n" - or print "\$sth->{NAME} ............... not ok: ", join(" ", @name), "\n"; - -my @type = @{$sth->{TYPE}}; -( join(" ", @type) eq q{16 1042 1042 1042 1043 25 1082 23 1007 701 600 601 603} ) - and print "\$sth->{TYPE} ............... ok\n" - or print "\$sth->{TYPE} ............... not ok: ", join(" ", @type), "\n"; - -my @pg_size = @{$sth->{pg_size}}; -( join(" ", @pg_size) eq q{1 -1 -1 -1 -1 -1 4 4 -1 8 16 32 32} ) - and print "\$sth->{pg_size} ............ ok\n" - or print "\$sth->{pg_size} ............ not ok: ", join(" ", @pg_size), "\n"; - -my @pg_type = @{$sth->{pg_type}}; -( join(" ", @pg_type) eq q{bool bpchar bpchar bpchar varchar text date int4 _int4 float8 point lseg box} ) - and print "\$sth->{pg_type} ............ ok\n" - or print "\$sth->{pg_type} ............ not ok: ", join(" ", @pg_type), "\n"; - -# test binding of output columns - -$sth->execute or die $DBI::errstr; - -my ($bool, $char, $char12, $char16, $vchar12, $text, $date, $int4, $int4a, $float8, $point, $lseg, $box); -( $sth->bind_columns(undef, \$bool, \$char, \$char12, \$char16, \$vchar12, \$text, \$date, \$int4, \$int4a, \$float8, \$point, \$lseg, \$box) ) - and print "\$sth->bind_columns ......... ok\n" - or print "\$sth->bind_columns ......... not ok: ", $DBI::errstr; - -$sth->fetch or die $DBI::errstr; -( "$bool, $char, $char12, $char16, $vchar12, $text, $date, $int4, $int4a, $float8, $point, $lseg, $box" eq - q{1, a, Edmund Mergl, quote \ ' this , Edmund Mergl, Edmund Mergl, 1997-03-08, 1234, {1,2,3}, 1.234, (1,2), [(1,2),(3,4)], (3,4),(1,2)} ) - and print "\$sth->fetch ................ ok\n" - or print "\$sth->fetch ................ not ok: $bool, $char, $char12, $char16, $vchar12, $text, $date, $int4, $int4a, $float8, $point, $lseg, $box\n"; - -my $gaga; -( $sth->bind_col(5, \$gaga) ) - and print "\$sth->bind_col ............. ok\n" - or print "\$sth->bind_col ............. not ok: ", $DBI::errstr; - -$sth->fetch or die $DBI::errstr; -( $gaga eq q{Halli Hallo} ) - and print "\$sth->fetch ................ ok\n" - or print "\$sth->fetch ................ not ok: $gaga\n"; - -$sth->finish or die $DBI::errstr; - -# select from table using input parameters - -$sth = $dbh->prepare( "SELECT * FROM builtin where char16_ = ?" ) or die $DBI::errstr; - -my $string = q{quote \ ' this}; -$sth->bind_param(1, $string) or die $DBI::errstr; - -# $dbh->{pg_auto_escape} = 1; -# is needed for $string above and is on by default -$sth->execute or die $DBI::errstr; - -$sth->{ChopBlanks} = 1; -@row_ary = $sth->fetchrow_array; -( join(" ", @row_ary) eq q{1 a Edmund Mergl quote \ ' this Edmund Mergl Edmund Mergl 1997-03-08 1234 {1,2,3} 1.234 (1,2) [(1,2),(3,4)] (3,4),(1,2)} ) - and print "\$sth->{ChopBlanks} ......... ok\n" - or print "\$sth->{ChopBlanks} .......... not ok: ", join(" ", @row_ary), "\n"; - -my $rows = $sth->rows; -( 1 == $rows ) - and print "\$sth->rows ................. ok\n" - or print "\$sth->rows ................. not ok: $rows\n"; - -$sth->finish or die $DBI::errstr; - -######################### test copy to/from stdout/stdin - -$dbh->do( "DELETE FROM builtin" ) or die $DBI::errstr; - -$dbh->do( "COPY builtin FROM STDIN" ) or die $DBI::errstr; - -my $ret; -for (1..3) { - # watch the tabs and do not forget the newlines - $ret = $dbh->func("t a Edmund Mergl Edmund Mergl Edmund Mergl Edmund Mergl 1997-03-08 1234 {1,2,3} 1.234 (1.0,2.0) ((1.0,2.0),(3.0,4.0)) ((1.0,2.0),(3.0,4.0))\n", 'putline'); -} -$dbh->func("\\.\n", 'putline'); -$dbh->func('endcopy'); - -( 1 == $ret ) - and print "\$dbh->func(putline) ........ ok\n" - or print "\$dbh->func(putline) ........ not ok: ", $ret, "\n"; - -$dbh->do( "COPY builtin TO STDOUT" ) or die $DBI::errstr; -my $buf = ''; -$ret = 0; -$rows = 0; -while ($dbh->func($buf, 256, 'getline')) { - #print "$buf\n"; - $rows++; -} -$dbh->func('endcopy'); - -( 3 == $rows ) - and print "\$dbh->func(getline) ........ ok\n" - or print "\$dbh->func(getline) ........ not ok: ", $rows, "\n"; - - -######################### test large objects - -# create large object from binary file - -my ($ascii, $pgin); -foreach $ascii (0..255) { - $pgin .= chr($ascii); -}; - -my $PGIN = '/tmp/pgin'; -open(PGIN, ">$PGIN") or die "can not open $PGIN"; -print PGIN $pgin; -close PGIN; - -# begin transaction -$dbh->{AutoCommit} = 0; - -my $lobjId; -( $lobjId = $dbh->func($PGIN, 'lo_import') ) - and print "\$dbh->func(lo_import) ...... ok\n" - or print "\$dbh->func(lo_import) ...... not ok\n"; - -# end transaction -$dbh->{AutoCommit} = 1; - -unlink $PGIN; - - -# blob_read - -# begin transaction -$dbh->{AutoCommit} = 0; - -$sth = $dbh->prepare( "" ) or die $DBI::errstr; - -my $blob; -( $blob = $sth->blob_read($lobjId, 0, 0) ) - and print "\$sth->blob_read ............ ok\n" - or print "\$sth->blob_read ............ not ok\n"; - -$sth->finish or die $DBI::errstr; - -# end transaction -$dbh->{AutoCommit} = 1; - - -# read large object using lo-functions - -# begin transaction -$dbh->{AutoCommit} = 0; - -my $lobj_fd; # may be 0 -( defined($lobj_fd = $dbh->func($lobjId, $dbh->{pg_INV_READ}, 'lo_open')) ) - and print "\$dbh->func(lo_open) ........ ok\n" - or print "\$dbh->func(lo_open) ........ not ok\n"; - -( 0 == $dbh->func($lobj_fd, 0, 0, 'lo_lseek') ) - and print "\$dbh->func(lo_lseek) ....... ok\n" - or print "\$dbh->func(lo_lseek) ....... not ok\n"; - -$buf = ''; -( 256 == $dbh->func($lobj_fd, $buf, 256, 'lo_read') ) - and print "\$dbh->func(lo_read) ........ ok\n" - or print "\$dbh->func(lo_read) ........ not ok\n"; - -( 256 == $dbh->func($lobj_fd, 'lo_tell') ) - and print "\$dbh->func(lo_tell) ........ ok\n" - or print "\$dbh->func(lo_tell) ........ not ok\n"; - -( $dbh->func($lobj_fd, 'lo_close') ) - and print "\$dbh->func(lo_close) ....... ok\n" - or print "\$dbh->func(lo_close) ....... not ok\n"; - -# end transaction -$dbh->{AutoCommit} = 1; - -( $dbh->func($lobjId, 'lo_unlink') ) - and print "\$dbh->func(lo_unlink) ...... ok\n" - or print "\$dbh->func(lo_unlink) ...... not ok\n"; - -# compare large objects - -( $pgin cmp $buf and $pgin cmp $blob ) - and print "compare blobs .............. not ok\n" - or print "compare blobs .............. ok\n"; - -######################### disconnect and drop test database - -# disconnect - -( $dbh->disconnect ) - and print "\$dbh->disconnect ........... ok\n" - or die "\$dbh->disconnect ........... not ok: ", $DBI::errstr; - -$dbh0->do("DROP DATABASE $dbtest"); -$dbh0->disconnect; - -print "test sequence finished.\n"; - -######################### EOF diff --git a/monitoring/PerlModules/CPAN/Error-0.15/BUILD b/monitoring/PerlModules/CPAN/Error-0.15/BUILD deleted file mode 100644 index d53f022..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/BUILD +++ /dev/null @@ -1,44 +0,0 @@ -# Macros - -#control upversion -%define external_package 1 - -%define name Error -%define cvs_package PerlModules/CPAN/Error-0.15 - - -# Package specific stuff -Name: Error -Version: 1.2.0 -Release: 1 -Packager: Rod McChesney <rmcchesney(a)nocpulse.com> -Summary: Try/catch/throw for Perl -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: noarch -Requires: perl -Group: unsorted -License: GPL or Artistic -Vendor: Red Hat, Inc. -Prefix: %{_our_prefix} -BuildRoot: %{_tmppath}/%cvs_package - -%description - -Provides Perl try/catch/throw semantics by wrapping die. - -%prep -%entirely_abstract_build_step - -%build -%makefile_build - -%install -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - -%files -f %{name}-%{version}-%{release}-filelist - -%clean -%abstract_clean_script diff --git a/monitoring/PerlModules/CPAN/Error-0.15/ChangeLog b/monitoring/PerlModules/CPAN/Error-0.15/ChangeLog deleted file mode 100644 index 2b8597d..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/ChangeLog +++ /dev/null @@ -1,73 +0,0 @@ -Oct 9 2001 <u_arunkumar(a)yahoo.com> (Arun Kumar U) - - Error.pm #0.15 - - - Removed the run_clauses calls from the stack trace - -May 12 2001 <u_arunkumar(a)yahoo.com> (Arun Kumar U) - - Error.pm #0.14 - - - Added overloading method for 'bool'. This was neccessary so that - examining the value of $@ after a eval block, returns a true - value - - Applied the diffs from Graham's code base - - Changed README with more information about the module - -Change 436 on 2000/03/29 by <gbarr(a)pobox.com> (Graham Barr) - - Added ppd stuff to MANIFEST and Makefile.PL - -Change 435 on 2000/03/29 by <gbarr(a)pobox.com> (Graham Barr) - - Changed README to contain examples from the POD - -Change 434 on 2000/03/29 by <gbarr(a)pobox.com> (Graham Barr) - - Documentation updates - removed experimental warning, too many users now to change too much. - -Change 422 on 2000/03/28 by <gbarr(a)pobox.com> (Graham Barr) - - Some tidy-ups - -Change 145 on 1998/05/31 by <gbarr(a)pobox.com> (Graham Barr) - - Errno.pm - - Separated run_clauses out into a sub - -Oct 28 1997 <gbarr(a)pobox.com> - - Error.pm #0.12 - - - Removed proceed clause - -Oct 27 1997 <gbarr(a)pobox.com> - - Error.pm #0.11 - - - Fixed calling of otherwise clause if there are no catch claues - -Oct 21 1997 <gbarr(a)pobox.com> - - Error.pm #0.10 - - - Added proceed clause, the return value from the proceed block - will be returned by throw. - - try will now return the result from the try block - or from the catch - - Changed except clause handling so that block is only evaluated - once, the first time the result is required. - - Changed catch and proceed blocks to accept two arguments. The - second argument is a reference to a scalar, which if set to true - will cause Error to continue looking for a catch/proceed block - when the block returns. - -Oct 19 1997 <gbarr(a)pobox.com> - - - Added associate method so that an existing error may be associated - with an object. - -Oct 10 1997 <gbarr(a)pobox.com> - - - Initial release for private viewing diff --git a/monitoring/PerlModules/CPAN/Error-0.15/Error.pm b/monitoring/PerlModules/CPAN/Error-0.15/Error.pm deleted file mode 100644 index c06819f..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/Error.pm +++ /dev/null @@ -1,750 +0,0 @@ -# Error.pm -# -# Copyright (c) 1997-8 Graham Barr <gbarr(a)ti.com>. All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -# Based on my original Error.pm, and Exceptions.pm by Peter Seibel -# <peter(a)weblogic.com> and adapted by Jesse Glick <jglick(a)sig.bsh.com>. -# -# but modified ***significantly*** - -package Error; - -use strict; -use vars qw($VERSION); -use 5.004; - -$VERSION = "0.15"; - -use overload ( - '""' => 'stringify', - '0+' => 'value', - 'bool' => sub { return 1; }, - 'fallback' => 1 -); - -$Error::Depth = 0; # Depth to pass to caller() -$Error::Debug = 0; # Generate verbose stack traces -@Error::STACK = (); # Clause stack for try -$Error::THROWN = undef; # last error thrown, a workaround until die $ref works - -my $LAST; # Last error created -my %ERROR; # Last error associated with package - -# Exported subs are defined in Error::subs - -sub import { - shift; - local $Exporter::ExportLevel = $Exporter::ExportLevel + 1; - Error::subs->import(@_); -} - -# I really want to use last for the name of this method, but it is a keyword -# which prevent the syntax last Error - -sub prior { - shift; # ignore - - return $LAST unless @_; - - my $pkg = shift; - return exists $ERROR{$pkg} ? $ERROR{$pkg} : undef - unless ref($pkg); - - my $obj = $pkg; - my $err = undef; - if($obj->isa('HASH')) { - $err = $obj->{'__Error__'} - if exists $obj->{'__Error__'}; - } - elsif($obj->isa('GLOB')) { - $err = ${*$obj}{'__Error__'} - if exists ${*$obj}{'__Error__'}; - } - - $err; -} - -# Return as much information as possible about where the error -# happened. The -stacktrace element only exists if $Error::DEBUG -# was set when the error was created - -sub stacktrace { - my $self = shift; - - return $self->{'-stacktrace'} - if exists $self->{'-stacktrace'}; - - my $text = exists $self->{'-text'} ? $self->{'-text'} : "Died"; - - $text .= sprintf(" at %s line %d.\n", $self->file, $self->line) - unless($text =~ /\n$/s); - - $text; -} - -# Allow error propagation, ie -# -# $ber->encode(...) or -# return Error->prior($ber)->associate($ldap); - -sub associate { - my $err = shift; - my $obj = shift; - - return unless ref($obj); - - if($obj->isa('HASH')) { - $obj->{'__Error__'} = $err; - } - elsif($obj->isa('GLOB')) { - ${*$obj}{'__Error__'} = $err; - } - $obj = ref($obj); - $ERROR{ ref($obj) } = $err; - - return; -} - -sub new { - my $self = shift; - my($pkg,$file,$line) = caller($Error::Depth); - - my $err = bless { - '-package' => $pkg, - '-file' => $file, - '-line' => $line, - @_ - }, $self; - - $err->associate($err->{'-object'}) - if(exists $err->{'-object'}); - - # To always create a stacktrace would be very inefficient, so - # we only do it if $Error::Debug is set - - if($Error::Debug) { - require Carp; - local $Carp::CarpLevel = $Error::Depth; - my $text = defined($err->{'-text'}) ? $err->{'-text'} : "Error"; - my $trace = Carp::longmess($text); - # Remove try calls from the trace - $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; - $trace =~ s/(\n\s+\S+__ANON__[^\n]+)?\n\s+eval[^\n]+\n\s+Error::subs::run_clauses[^\n]+\n\s+Error::subs::try[^\n]+(?=\n)//sog; - $err->{'-stacktrace'} = $trace - } - - $@ = $LAST = $ERROR{$pkg} = $err; -} - -# Throw an error. this contains some very gory code. - -sub throw { - my $self = shift; - local $Error::Depth = $Error::Depth + 1; - - # if we are not rethrow-ing then create the object to throw - $self = $self->new(@_) unless ref($self); - - die $Error::THROWN = $self; -} - -# syntactic sugar for -# -# die with Error( ... ); - -sub with { - my $self = shift; - local $Error::Depth = $Error::Depth + 1; - - $self->new(@_); -} - -# syntactic sugar for -# -# record Error( ... ) and return; - -sub record { - my $self = shift; - local $Error::Depth = $Error::Depth + 1; - - $self->new(@_); -} - -# catch clause for -# -# try { ... } catch CLASS with { ... } - -sub catch { - my $pkg = shift; - my $code = shift; - my $clauses = shift || {}; - my $catch = $clauses->{'catch'} ||= []; - - unshift @$catch, $pkg, $code; - - $clauses; -} - -# Object query methods - -sub object { - my $self = shift; - exists $self->{'-object'} ? $self->{'-object'} : undef; -} - -sub file { - my $self = shift; - exists $self->{'-file'} ? $self->{'-file'} : undef; -} - -sub line { - my $self = shift; - exists $self->{'-line'} ? $self->{'-line'} : undef; -} - -sub text { - my $self = shift; - exists $self->{'-text'} ? $self->{'-text'} : undef; -} - -# overload methods - -sub stringify { - my $self = shift; - defined $self->{'-text'} ? $self->{'-text'} : "Died"; -} - -sub value { - my $self = shift; - exists $self->{'-value'} ? $self->{'-value'} : undef; -} - -package Error::Simple; - -@Error::Simple::ISA = qw(Error); - -sub new { - my $self = shift; - my $text = "" . shift; - my $value = shift; - my(@args) = (); - - local $Error::Depth = $Error::Depth + 1; - - @args = ( -file => $1, -line => $2) - if($text =~ s/ at (\S+) line (\d+)(\.\n)?$//s); - - push(@args, '-value', 0 + $value) - if defined($value); - - $self->SUPER::new(-text => $text, @args); -} - -sub stringify { - my $self = shift; - my $text = $self->SUPER::stringify; - $text .= sprintf(" at %s line %d.\n", $self->file, $self->line) - unless($text =~ /\n$/s); - $text; -} - -########################################################################## -########################################################################## - -# Inspired by code from Jesse Glick <jglick(a)sig.bsh.com> and -# Peter Seibel <peter(a)weblogic.com> - -package Error::subs; - -use Exporter (); -use vars qw(@EXPORT_OK @ISA %EXPORT_TAGS); - -@EXPORT_OK = qw(try with finally except otherwise); -%EXPORT_TAGS = (try => \@EXPORT_OK); - -@ISA = qw(Exporter); - -sub run_clauses ($$$\@) { - my($clauses,$err,$wantarray,$result) = @_; - my $code = undef; - - $err = new Error::Simple($err) unless ref($err); - - CATCH: { - - # catch - my $catch; - if(defined($catch = $clauses->{'catch'})) { - my $i = 0; - - CATCHLOOP: - for( ; $i < @$catch ; $i += 2) { - my $pkg = $catch->[$i]; - unless(defined $pkg) { - #except - splice(@$catch,$i,2,$catch->[$i+1]->()); - $i -= 2; - next CATCHLOOP; - } - elsif($err->isa($pkg)) { - $code = $catch->[$i+1]; - while(1) { - my $more = 0; - local($Error::THROWN); - my $ok = eval { - if($wantarray) { - @{$result} = $code->($err,\$more); - } - elsif(defined($wantarray)) { - @{$result} = (); - $result->[0] = $code->($err,\$more); - } - else { - $code->($err,\$more); - } - 1; - }; - if( $ok ) { - next CATCHLOOP if $more; - undef $err; - } - else { - $err = defined($Error::THROWN) - ? $Error::THROWN : $@; - $err = new Error::Simple($err) - unless ref($err); - } - last CATCH; - }; - } - } - } - - # otherwise - my $owise; - if(defined($owise = $clauses->{'otherwise'})) { - my $code = $clauses->{'otherwise'}; - my $more = 0; - my $ok = eval { - if($wantarray) { - @{$result} = $code->($err,\$more); - } - elsif(defined($wantarray)) { - @{$result} = (); - $result->[0] = $code->($err,\$more); - } - else { - $code->($err,\$more); - } - 1; - }; - if( $ok ) { - undef $err; - } - else { - $err = defined($Error::THROWN) - ? $Error::THROWN : $@; - $err = new Error::Simple($err) - unless ref($err); - } - } - } - $err; -} - -sub try (&;$) { - my $try = shift; - my $clauses = @_ ? shift : {}; - my $ok = 0; - my $err = undef; - my @result = (); - - unshift @Error::STACK, $clauses; - - my $wantarray = wantarray(); - - do { - local $Error::THROWN = undef; - - $ok = eval { - if($wantarray) { - @result = $try->(); - } - elsif(defined $wantarray) { - $result[0] = $try->(); - } - else { - $try->(); - } - 1; - }; - - $err = defined($Error::THROWN) ? $Error::THROWN : $@ - unless $ok; - }; - - shift @Error::STACK; - - $err = run_clauses($clauses,$err,wantarray,@result) - unless($ok); - - $clauses->{'finally'}->() - if(defined($clauses->{'finally'})); - - # rmcchesney(a)nocpulse.com: Don't assume $err knows how to throw. - if (defined($err)) { - if ($err->can('throw')) { - throw $err; - } else { - die $err; - } - } - wantarray ? @result : $result[0]; -} - -# Each clause adds a sub to the list of clauses. The finally clause is -# always the last, and the otherwise clause is always added just before -# the finally clause. -# -# All clauses, except the finally clause, add a sub which takes one argument -# this argument will be the error being thrown. The sub will return a code ref -# if that clause can handle that error, otherwise undef is returned. -# -# The otherwise clause adds a sub which unconditionally returns the users -# code reference, this is why it is forced to be last. -# -# The catch clause is defined in Error.pm, as the syntax causes it to -# be called as a method - -sub with (&;$) { - @_ -} - -sub finally (&) { - my $code = shift; - my $clauses = { 'finally' => $code }; - $clauses; -} - -# The except clause is a block which returns a hashref or a list of -# key-value pairs, where the keys are the classes and the values are subs. - -sub except (&;$) { - my $code = shift; - my $clauses = shift || {}; - my $catch = $clauses->{'catch'} ||= []; - - my $sub = sub { - my $ref; - my(@array) = $code->($_[0]); - if(@array == 1 && ref($array[0])) { - $ref = $array[0]; - $ref = [ %$ref ] - if(UNIVERSAL::isa($ref,'HASH')); - } - else { - $ref = \@array; - } - @$ref - }; - - unshift @{$catch}, undef, $sub; - - $clauses; -} - -sub otherwise (&;$) { - my $code = shift; - my $clauses = shift || {}; - - if(exists $clauses->{'otherwise'}) { - require Carp; - Carp::croak("Multiple otherwise clauses"); - } - - $clauses->{'otherwise'} = $code; - - $clauses; -} - -1; -__END__ - -=head1 NAME - -Error - Error/exception handling in an OO-ish way - -=head1 SYNOPSIS - - use Error qw(:try); - - throw Error::Simple( "A simple error"); - - sub xyz { - ... - record Error::Simple("A simple error") - and return; - } - - unlink($file) or throw Error::Simple("$file: $!",$!); - - try { - do_some_stuff(); - die "error!" if $condition; - throw Error::Simple -text => "Oops!" if $other_condition; - } - catch Error::IO with { - my $E = shift; - print STDERR "File ", $E->{'-file'}, " had a problem\n"; - } - except { - my $E = shift; - my $general_handler=sub {send_message $E->{-description}}; - return { - UserException1 => $general_handler, - UserException2 => $general_handler - }; - } - otherwise { - print STDERR "Well I don't know what to say\n"; - } - finally { - close_the_garage_door_already(); # Should be reliable - }; # Don't forget the trailing ; or you might be surprised - -=head1 DESCRIPTION - -The C<Error> package provides two interfaces. Firstly C<Error> provides -a procedural interface to exception handling. Secondly C<Error> is a -base class for errors/exceptions that can either be thrown, for -subsequent catch, or can simply be recorded. - -Errors in the class C<Error> should not be thrown directly, but the -user should throw errors from a sub-class of C<Error>. - -=head1 PROCEDURAL INTERFACE - -C<Error> exports subroutines to perform exception handling. These will -be exported if the C<:try> tag is used in the C<use> line. - -=over 4 - -=item try BLOCK CLAUSES - -C<try> is the main subroutine called by the user. All other subroutines -exported are clauses to the try subroutine. - -The BLOCK will be evaluated and, if no error is throw, try will return -the result of the block. - -C<CLAUSES> are the subroutines below, which describe what to do in the -event of an error being thrown within BLOCK. - -=item catch CLASS with BLOCK - -This clauses will cause all errors that satisfy C<$err-E<gt>isa(CLASS)> -to be caught and handled by evaluating C<BLOCK>. - -C<BLOCK> will be passed two arguments. The first will be the error -being thrown. The second is a reference to a scalar variable. If this -variable is set by the catch block then, on return from the catch -block, try will continue processing as if the catch block was never -found. - -To propagate the error the catch block may call C<$err-E<gt>throw> - -If the scalar reference by the second argument is not set, and the -error is not thrown. Then the current try block will return with the -result from the catch block. - -=item except BLOCK - -When C<try> is looking for a handler, if an except clause is found -C<BLOCK> is evaluated. The return value from this block should be a -HASHREF or a list of key-value pairs, where the keys are class names -and the values are CODE references for the handler of errors of that -type. - -=item otherwise BLOCK - -Catch any error by executing the code in C<BLOCK> - -When evaluated C<BLOCK> will be passed one argument, which will be the -error being processed. - -Only one otherwise block may be specified per try block - -=item finally BLOCK - -Execute the code in C<BLOCK> either after the code in the try block has -successfully completed, or if the try block throws an error then -C<BLOCK> will be executed after the handler has completed. - -If the handler throws an error then the error will be caught, the -finally block will be executed and the error will be re-thrown. - -Only one finally block may be specified per try block - -=back - -=head1 CLASS INTERFACE - -=head2 CONSTRUCTORS - -The C<Error> object is implemented as a HASH. This HASH is initialized -with the arguments that are passed to it's constructor. The elements -that are used by, or are retrievable by the C<Error> class are listed -below, other classes may add to these. - - -file - -line - -text - -value - -object - -If C<-file> or C<-line> are not specified in the constructor arguments -then these will be initialized with the file name and line number where -the constructor was called from. - -If the error is associated with an object then the object should be -passed as the C<-object> argument. This will allow the C<Error> package -to associate the error with the object. - -The C<Error> package remembers the last error created, and also the -last error associated with a package. This could either be the last -error created by a sub in that package, or the last error which passed -an object blessed into that package as the C<-object> argument. - -=over 4 - -=item throw ( [ ARGS ] ) - -Create a new C<Error> object and throw an error, which will be caught -by a surrounding C<try> block, if there is one. Otherwise it will cause -the program to exit. - -C<throw> may also be called on an existing error to re-throw it. - -=item with ( [ ARGS ] ) - -Create a new C<Error> object and returns it. This is defined for -syntactic sugar, eg - - die with Some::Error ( ... ); - -=item record ( [ ARGS ] ) - -Create a new C<Error> object and returns it. This is defined for -syntactic sugar, eg - - record Some::Error ( ... ) - and return; - -=back - -=head2 STATIC METHODS - -=over 4 - -=item prior ( [ PACKAGE ] ) - -Return the last error created, or the last error associated with -C<PACKAGE> - -=back - -=head2 OBJECT METHODS - -=over 4 - -=item stacktrace - -If the variable C<$Error::Debug> was non-zero when the error was -created, then C<stacktrace> returns a string created by calling -C<Carp::longmess>. If the variable was zero the C<stacktrace> returns -the text of the error appended with the filename and line number of -where the error was created, providing the text does not end with a -newline. - -=item object - -The object this error was associated with - -=item file - -The file where the constructor of this error was called from - -=item line - -The line where the constructor of this error was called from - -=item text - -The text of the error - -=back - -=head2 OVERLOAD METHODS - -=over 4 - -=item stringify - -A method that converts the object into a string. This method may simply -return the same as the C<text> method, or it may append more -information. For example the file name and line number. - -By default this method returns the C<-text> argument that was passed to -the constructor, or the string C<"Died"> if none was given. - -=item value - -A method that will return a value that can be associated with the -error. For example if an error was created due to the failure of a -system call, then this may return the numeric value of C<$!> at the -time. - -By default this method returns the C<-value> argument that was passed -to the constructor. - -=back - -=head1 PRE-DEFINED ERROR CLASSES - -=over 4 - -=item Error::Simple - -This class can be used to hold simple error strings and values. It's -constructor takes two arguments. The first is a text value, the second -is a numeric value. These values are what will be returned by the -overload methods. - -If the text value ends with C<at file line 1> as $@ strings do, then -this infomation will be used to set the C<-file> and C<-line> arguments -of the error object. - -This class is used internally if an eval'd block die's with an error -that is a plain string. - -=back - -=head1 KNOWN BUGS - -None, but that does not mean there are not any. - -=head1 AUTHORS - -Graham Barr <gbarr(a)pobox.com> - -The code that inspired me to write this was originally written by -Peter Seibel <peter(a)weblogic.com> and adapted by Jesse Glick -<jglick(a)sig.bsh.com>. - -=head1 MAINTAINER - -Arun Kumar U <u_arunkumar(a)yahoo.com> - -=cut diff --git a/monitoring/PerlModules/CPAN/Error-0.15/Error.ppd b/monitoring/PerlModules/CPAN/Error-0.15/Error.ppd deleted file mode 100644 index 51e87d1..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/Error.ppd +++ /dev/null @@ -1,10 +0,0 @@ -<SOFTPKG NAME="Error" VERSION="0,15,0,0"> - <TITLE>Error</TITLE> - <ABSTRACT>Error/exception handling in an OO-ish way</ABSTRACT> - <AUTHOR>Graham Barr <gbarr(a)pobox.com></AUTHOR> - <IMPLEMENTATION> - <OS NAME="linux" /> - <ARCHITECTURE NAME="i586-linux" /> - <CODEBASE HREF="" /> - </IMPLEMENTATION> -</SOFTPKG> diff --git a/monitoring/PerlModules/CPAN/Error-0.15/MANIFEST b/monitoring/PerlModules/CPAN/Error-0.15/MANIFEST deleted file mode 100644 index 53b338b..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/MANIFEST +++ /dev/null @@ -1,9 +0,0 @@ -ChangeLog -Error.pm -Error.ppd -MANIFEST -Makefile.PL -README -example -t/01throw.t -t/02order.t diff --git a/monitoring/PerlModules/CPAN/Error-0.15/Makefile.PL b/monitoring/PerlModules/CPAN/Error-0.15/Makefile.PL deleted file mode 100644 index b311fe0..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/Makefile.PL +++ /dev/null @@ -1,29 +0,0 @@ -use ExtUtils::MakeMaker; -use 5.004; - -my @ppd; - -if ($] >= 5.00503) { - @ppd = ( - AUTHOR => 'Graham Barr <gbarr(a)pobox.com>', - ABSTRACT => 'Error/exception handling in an OO-ish way' - ); -} - -WriteMakefile( - NAME => 'Error', - VERSION_FROM => 'Error.pm', - @ppd -); - -sub MY::postamble { - - return '' unless $] >= 5.00503; - -<<'ESQ'; - -dist : ppd - -ESQ -} - diff --git a/monitoring/PerlModules/CPAN/Error-0.15/README b/monitoring/PerlModules/CPAN/Error-0.15/README deleted file mode 100644 index 25e157a..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/README +++ /dev/null @@ -1,91 +0,0 @@ - -NAME - Error - Error/exception handling in an OO-ish way - -DESCRIPTION - The Error package provides two interfaces. Firstly Error provides - a procedural interface to exception handling. Secondly Error is a - base class for errors/exceptions that can either be thrown, for - subsequent catch, or can simply be recorded. - - Errors in the class Error should not be thrown directly, but the - user should throw errors from a sub-class of Error - -SYNOPSIS - - use Error qw(:try); - - throw Error::Simple( "A simple error"); - - sub xyz { - ... - record Error::Simple("A simple error") - and return; - } - - unlink($file) or throw Error::Simple("$file: $!",$!); - - try { - do_some_stuff(); - die "error!" if $condition; - throw Error::Simple -text => "Oops!" if $other_condition; - } - catch Error::IO with { - my $E = shift; - print STDERR "File ", $E->{'-file'}, " had a problem\n"; - } - except { - my $E = shift; - my $general_handler=sub {send_message $E->{-description}}; - return { - UserException1 => $general_handler, - UserException2 => $general_handler - }; - } - otherwise { - print STDERR "Well I don't know what to say\n"; - } - finally { - close_the_garage_door_already(); # Should be reliable - }; # Don't forget the trailing ; or you might be surprised - -AUTHORS - - Graham Barr <gbarr(a)pobox.com> - - The code that inspired me to write this was originally written by - Peter Seibel <peter(a)weblogic.com> and adapted by Jesse Glick - <jglick(a)sig.bsh.com>. - -MAINTAINER - - Arun Kumar U <u_arunkumar(a)yahoo.com> - - ===================== - -HOW TO INSTALL IT ? - -To install this module, cd to the directory that contains this README -file and type the following: - - perl Makefile.PL - make test - make install - -To install this module into a specific directory, do: -perl Makefile.PL PREFIX=/name/of/the/directory -...the rest is the same... - -Please also read the perlmodinstall man page, if available. - -Share and Enjoy !! - -Arun Kumar U -<u_arunkumar(a)yahoo.com> - -------------------------------------------------------------------------------- - Only wimps use tape backup: *real* men just upload their important - stuff on ftp, and let the rest of the world mirror it. - - Linus Torvalds -------------------------------------------------------------------------------- - diff --git a/monitoring/PerlModules/CPAN/Error-0.15/example b/monitoring/PerlModules/CPAN/Error-0.15/example deleted file mode 100644 index 59da597..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/example +++ /dev/null @@ -1,51 +0,0 @@ - -use lib '.'; -use Error qw(:try); - -@Error::Bad::ISA = qw(Error); - -$Error::Debug = 1; # turn on verbose stacktrace - -sub abc { - try { - try { - throw Error::Simple("a simple error"); - } - catch Error::Simple with { - my $err = shift; - throw Error::Bad(-text => "some text"); - } - except { - return { - Error::Simple => sub { warn "simple" } - } - } - otherwise { - 1; - } finally { - warn "finally\n"; - }; - } - catch Error::Bad with { - 1; - }; -} - -sub def { - unlink("not such file") or - record Error::Simple("unlink: $!", $!) and return; - 1; -} - -abc(); - - -$x = prior Error; - -print "--\n",$x->stacktrace; - -unless(defined def()) { - $x = prior Error 'main'; - print "--\n",0+$x,"\n",$x; -} - diff --git a/monitoring/PerlModules/CPAN/Error-0.15/t/01throw.t b/monitoring/PerlModules/CPAN/Error-0.15/t/01throw.t deleted file mode 100644 index a1bdba2..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/t/01throw.t +++ /dev/null @@ -1,25 +0,0 @@ - -use Error qw(:try); - -print "1..4\n"; - -try { - print "ok 1\n"; -}; - - -try { - throw Error::Simple("ok 2\n",2); - print "not ok 2\n"; -} -catch Error::Simple with { - my $err = shift; - print "$err"; -} -finally { - print "ok 3\n"; -}; - -$err = prior Error; - -print "ok ",2+$err,"\n";; diff --git a/monitoring/PerlModules/CPAN/Error-0.15/t/02order.t b/monitoring/PerlModules/CPAN/Error-0.15/t/02order.t deleted file mode 100644 index 7d1e59d..0000000 --- a/monitoring/PerlModules/CPAN/Error-0.15/t/02order.t +++ /dev/null @@ -1,47 +0,0 @@ - -use Error qw(:try); - -@Error::Fatal::ISA = qw(Error); - -print "1..6\n"; - -$num = try { - try { - try { - throw Error::Simple("ok 1\n"); - } - catch Error::Simple with { - my $err = shift; - print $err; - - throw Error::Fatal(-value => 4); - - print "not ok 3\n"; - } - catch Error::Fatal with { - exit(1); - } - finally { - print "ok 2\n"; - }; - } finally { - print "ok 3\n"; - }; -} -catch Error::Fatal with { - my $err = shift; - my $more = shift; - $$more = 1; - print "ok ",0+$err,"\n"; -} -catch Error::Fatal with { - my $err = shift; - print "ok ",1+$err,"\n"; - return 6; -} -catch Error::Fatal with { - my $err = shift; - print "not ok ",2+$err,"\n"; -}; - -print "ok ",$num,"\n"; diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/BUILD b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/BUILD deleted file mode 100644 index e2be2b3..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/BUILD +++ /dev/null @@ -1,46 +0,0 @@ -# Macros - -#control upversion -%define external_package 1 - -%define cvs_package PerlModules/CPAN/HTML-TableExtract-1.08 - -# Package specific stuff -Name: perl-HTML-TableExtract -Version: 1.8.0 -Release: 4.2 -Packager: Nick Hansen <nhansen(a)redhat.com> -Summary: HTML table extractor -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: noarch -Prereq: perl -Group: unsorted -URL: http://www.mojotoad.com/sisk/projects/HTML-TableExtract/ -License: GPL or Artistic -Vendor: Red Hat, Inc. -Prefix: %{_our_prefix} -BuildRoot: %{_tmppath}/%cvs_package - -%description - -HTML::TableExtract is a subclass of HTML::Parser that serves to extract -the textual information from tables of interest contained within an HTML document. -The text from each extracted table is stored in tabe state objects which -hold the information as an array of arrays that represent the rows and cells of that table. - -%prep -%entirely_abstract_build_step - -%build -%makefile_build - -%install -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - -%files -f %{name}-%{version}-%{release}-filelist - -%clean -%abstract_clean_script diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Changes b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Changes deleted file mode 100644 index b9f837f..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Changes +++ /dev/null @@ -1,59 +0,0 @@ -Revision history for Perl extension HTML::TableExtract. - -1.08 Thu Apr 4 11:26:27 CST 2002 - - Added some more crufty HTML tolerance -- not - PC (puristicly correct) but HTML correctness - is probably of no interest to those merely - trying to extract information *out* of HTML. - - Fixed a mapback problem with the legacy methods - -1.07 Wed Aug 22 06:14:24 CDT 2001 - - Added keep_html option for HTML retention - - bug fix for depth/count targets - -1.06 Thu Nov 2 15:29:49 CST 2000 - - Added translation to newlines (enabled by default) - - cleaned up some warnings - -1.05 Sun Aug 6 06:38:14 CDT 2000 - - minor bug fix involving empty cells - -1.04 Sat Jul 15 02:18:04 CDT 2000 - - fixed gridmap bug involving skew calcs on unwanted - columns - - added example page reference in README - -1.03 Tue Jul 7 03:43:30 CDT 2000 - - gridmap option, columns are really columns regardless - of cell span skew - - Added chains for relative targeting - * Terminus-matching by default - * Elasticity option - * Waypoint retention option - * Lineage tracking (match record along chain) - - Significant tests added to 'make test' - - Documentation rewrite - -0.05 Tue Mar 21 08:11:54 CST 2000 - - Fixed -w init warnings for dangling columns in header mode - - added 'decode' option to turn off text decoding when desired - - internally stores real slices right now rather than sparse - tables that later get massaged. - -0.03 Thu Mar 9 13:10:03 CST 2000 - - Fixed bug regarding incomplete defaults - - Tables, rows, and cells that are either empty - or contain no text are now properly noted - - Header patterns now match across stripped tags - - In some cases, mangled HTML tables are properly - scanned by inferring missing <TR> tags. - - Depth/Count votes are now properly honored. - - Cleaned up some -w noise. - -0.02 Thu Feb 10 13:43:04 CST 2000 - - Fixed some problems tracking counts at revisited depths. - - Minor doc fix, added mailing list - -0.01 Wed Feb 2 18:24:07 CST 2000 - - Initial version. - diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/MANIFEST b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/MANIFEST deleted file mode 100644 index 973e98c..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/MANIFEST +++ /dev/null @@ -1,6 +0,0 @@ -README -Changes -MANIFEST -Makefile.PL -test.pl -lib/HTML/TableExtract.pm diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Makefile.PL b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Makefile.PL deleted file mode 100644 index 586ec0b..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/Makefile.PL +++ /dev/null @@ -1,9 +0,0 @@ -use ExtUtils::MakeMaker; - -WriteMakefile( - NAME => 'HTML-TableExtract', - VERSION_FROM => 'lib/HTML/TableExtract.pm', - PREREQ_PM => { - HTML::Parser => 0, - } - ); diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/README b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/README deleted file mode 100644 index e3d25ec..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/README +++ /dev/null @@ -1,64 +0,0 @@ -HTML-TableExtract ------------------ - -HTML::TableExtract is a module that simplifies the extraction -of information contained in tables within HTML documents. - -Tables of note may be specified using Headers, Depth, Count, -or some combination of the three. See the module documentation -for details. - -INSTALLATION - -You install HTML-TableExtract, as you would install any perl module -library, by running these commands: - - perl Makefile.PL - make - make test - make install - -DOCUMENTATION - -See HTML/TableExtract.pm for the code. See Changes for recent -changes. POD style documentation is included in the module. -This is normally converted to a manual page and installed as part -of the "make install" process. You should also be able to use -the 'perldoc' utility to extract and read documentation from the -module directly. - -There is also an example page available: - - http://www.mojotoad.com/sisk/projects/HTML-TableExtract/tables.html - -SUPPORT - -There is a mailing list available. To register or examine archived -messages, go here: - - http://lists.sourceforge.net/mailman/listinfo/table-extract-general - -Questions and comments may also be directed to Matt Sisk <sisk(a)mojotoad.com> - -AVAILABILITY - -The package is available from CPAN: - - http://www.cpan.org/authors/id/M/MS/MSISK/ - -The latest version is also available at: - - http://www.mojotoad.com/sisk/projects/HTML-TableExtract/ - -ACKNOWLEDGEMENTS - -Thanks to the following people for their generous bug catching and -fault analysis: Celeste Suliin Burris, David Finberg, Robert Goff, -Jeremy Howard, Patrick Naubert, Volker Stuerzl, and Steve Wong. - -COPYRIGHT - -Copyright (c) 1999-2002 Matthew P. Sisk. All rights reserved. -All wrongs revenged. This program is free software; you can -redistribute it and/or modify it under the same terms as -Perl itself. diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/lib/HTML/TableExtract.pm b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/lib/HTML/TableExtract.pm deleted file mode 100644 index 00c0eba..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/lib/HTML/TableExtract.pm +++ /dev/null @@ -1,1902 +0,0 @@ -package HTML::TableExtract; - -# This package extracts tables from HTML. Tables of interest may be -# specified using header information, depth, order in a depth, or some -# combination of the three. See the POD for more information. -# -# Author: Matthew P. Sisk. See the POD for copyright information. - -use strict; -use Carp; - -use vars qw($VERSION @ISA); - -$VERSION = '1.08'; - -use HTML::Parser; -@ISA = qw(HTML::Parser); - -use HTML::Entities; - -my %Defaults = ( - headers => undef, - depth => undef, - count => undef, - chain => undef, - subtables => undef, - gridmap => 1, - decode => 1, - automap => 1, - br_translate => 1, - head_include => 0, - elastic => 1, - keep => 0, - keepall => 0, - debug => 0, - keep_html => 0, - ); -my $Dpat = join('|', keys %Defaults); - -### Constructor - -sub new { - my $that = shift; - my $class = ref($that) || $that; - - my(%pass, %parms, $k, $v); - while (($k,$v) = splice(@_, 0, 2)) { - if ($k eq 'headers' || $k eq 'chain') { - ref $v eq 'ARRAY' - or croak "Param '$k' must be passed in ref to array\n"; - if ($k eq 'chain') { - # Filter out non-links (has refs...allows for extra commas, etc) - @$v = grep(ref eq 'HASH', @$v); - } - $parms{$k} = $v; - } - elsif ($k =~ /^$Dpat$/) { - $parms{$k} = $v; - } - else { - $pass{$k} = $v; - } - } - - my $self = $class->SUPER::new(%pass); - bless $self, $class; - foreach (keys %parms, keys %Defaults) { - $self->{$_} = exists $parms{$_} && defined $parms{$_} ? - $parms{$_} : $Defaults{$_}; - } - if ($self->{headers}) { - print STDERR "TE here, headers: ", join(',', @{$self->{headers}}),"\n" - if $self->{debug}; - $self->{gridmap} = 1; - } - # Initialize counts and containers - $self->{_cdepth} = -1; - $self->{_tablestack} = []; - $self->{_tables} = {}; - $self->{_ts_sequential} = []; - $self->{_table_mapback} = {}; - $self->{_counts} = {}; - - $self; -} - -### HTML::Parser overrides - -sub start { - my $self = shift; - - # Create a new table state if entering a table. - if ($_[0] eq 'table') { - $self->_enter_table; - } - - # Rows and cells are next. We obviously need not bother checking any - # tags if we aren't in a table. - if ($self->{_in_a_table}) { - my $ts = $self->_current_table_state; - my $skiptag = 0; - if ($_[0] eq 'tr') { - $ts->_enter_row; - ++$skiptag; - } - elsif ($_[0] eq 'td' || $_[0] eq 'th') { - $ts->_enter_cell; - # Inspect rowspan/colspan attributes, record as necessary for - # future column count transforms. - if ($self->{gridmap}) { - my %attrs = ref $_[1] ? %{$_[1]} : {}; - if (exists $attrs{rowspan} || exists $attrs{colspan}) { - $ts->_skew($attrs{rowspan} || 1, $attrs{colspan} || 1); - } - } - ++$skiptag; - } - if ($self->{keep_html} && !$skiptag) { - $self->text($_[3]); - } - } - - # patch. We like to dispense with HTML, but blindly zapping - # will sometimes make the resulting text hard to parse if there - # is no newline. Therefore, when enabled, we replace with - # newline. Pointed out by Volker Stuerzl <Volker.Stuerzl(a)gmx.de> - if ($_[0] eq 'br' && $self->{br_translate} && !$self->{keep_html}) { - $self->text("\n"); - } - - -} # end start - -sub end { - my $self = shift; - # Don't bother if we're not actually in a table. - if ($self->{_in_a_table}) { - my $ts = $self->_current_table_state; - if ($_[0] eq 'td' || $_[0] eq 'th') { - $ts->_exit_cell; - } - elsif ($_[0] eq 'tr') { - $ts->_exit_row; - } - elsif ($_[0] eq 'table') { - $self->_exit_table; - } - $self->text($_[1]) if $self->{keep_html} && $ts->{in_cell}; - } -} - -sub text { - my $self = shift; - # Don't bother unless we are in a table - if ($self->{_in_a_table}) { - my $ts = $self->_current_table_state; - # Don't bother unless we are in a row or cell - return unless $ts->{in_cell}; - if ($ts->_text_hungry) { - $ts->_taste_text($self->{decode} ? decode_entities($_[0]) : $_[0]); - } - } -} - -### End HTML::Parser overrides - -### Report Methods - -sub depths { - # Return all depths where valid tables were located. - my $self = shift; - return () unless ref $self->{_tables}; - sort { $a <=> $b } keys %{$self->{_tables}}; -} - -sub counts { - # Given a depth, return the counts of all valid tables found therein. - my($self, $depth) = @_; - defined $depth or croak "Depth required\n"; - sort { $a <=> $b } keys %{$self->{_tables}{$depth}}; -} - -sub table { - # Return the table content for a particular depth and count - shift->table_state(@_)->{content}; -} - -sub table_state { - # Return the table state for a particular depth and count - my($self, $depth, $count) = @_; - defined $depth or croak "Depth required\n"; - defined $count or croak "Count required\n"; - if (! $self->{_tables}{$depth} || ! $self->{_tables}{$depth}{$count}) { - return undef; - } - $self->{_tables}{$depth}{$count}; -} - -sub rows { - # Return the rows for a table. First table found if no table - # specified. - my($self, $table) = @_; - my @tc; - if (!$table) { - $table = $self->first_table_found; - } - return () unless ref $table; - my $ts = $self->{_table_mapback}{$table}; - $ts->rows; -} - -sub first_table_found { - shift->first_table_state_found(@_)->{content}; -} - -sub first_table_state_found { - my $self = shift; - ref $self->{_ts_sequential}[0] ? $self->{_ts_sequential}[0] : {}; -} - -sub tables { - # Return content of all valid tables found, in the order that - # they were seen. - map($_->{content}, shift->table_states(@_)); -} - -sub table_states { - # Return all valid table records found, in the order that - # they were seen. - my $self = shift; - @{$self->{_ts_sequential}}; -} - -sub table_coords { - # Return the depth and count of a table - my($self, $table) = @_; - ref $table or croak "Table reference required\n"; - my $ts = $self->{_table_mapback}{$table}; - return () unless ref $ts; - $ts->coords; -} - -sub column_map { - # Return the column numbers of a particular table in the same order - # as the provided headers. - my($self, $table) = @_; - if (! defined $table) { - $table = $self->first_table_found; - } - my $ts = $self->{_table_mapback}{$table}; - return () unless ref $ts; - $ts->column_map; -} - -### Runtime - -sub _enter_table { - my $self = shift; - - ++$self->{_cdepth}; - ++$self->{_in_a_table}; - - my $depth = $self->{_cdepth}; - - # Table states can come and go on the stack...here we retrieve the - # table state for the table surrounding the current table tag - # (parent table state). If the current table tag belongs to a top - # level table, then this will be undef. - my $pts = $self->_current_table_state; - - # Counts are tracked for each depth. Depth count hashes are - # maintained for each of the table state objects; descendant - # tables accumulate a list of these hashes, all of which track - # counts relative to the point of view of that table state. - my $counts = ref $pts ? $pts->{counts} : [$self->{_counts}]; - foreach (@{$counts}) { - my $c = $_; - if (exists $_->{$depth}) { - ++$_->{$depth}; - } - else { - $_->{$depth} = 0; - } - } - my $count = $self->{_counts}{$depth} || 0; - - print STDERR "TABLE: cdepth $depth, ccount $count, it: $self->{_in_a_table}\n" - if $self->{debug} >= 2; - - # Umbrella status means that this current table and all of its - # descendant tables will be harvested. This can happen when there - # exist target conditions with no headers, depth, or count, or - # when a particular table has been selected and the subtables - # parameter was initially specified. - my $umbrella = 0; - if (ref $pts) { - # If the subtables parameter was specified and the last table was - # being harvested, the upcoming table (and therefore all of it's - # descendants) is under an umbrella. - ++$umbrella if $self->{subtables} && $pts->_active; - } - if (! defined $self->{depth} && !defined $self->{count} - && !$self->{headers} && !$self->{chain}) { - ++$umbrella; - } - - # Basic parameters for the soon-to-be-created table state. - my %tsparms = ( - depth => $depth, - count => $count, - umbrella => $umbrella, - automap => $self->{automap}, - elastic => $self->{elastic}, - counts => $counts, - keep => $self->{keep}, - keepall => $self->{keepall}, - debug => $self->{debug}, - keep_html => $self->{keep_html}, - ); - - # Target constraints. There is no point in passing any of these - # along if we are under an umbrella. Notice that with table states, - # "depth" and "count" are absolute coordinates recording where this - # table was created, whereas "tdepth" and "tcount" are the target - # constraints. Headers and chain have no "absolute" meaning, - # therefore are passed by the same name. - if (!$umbrella) { - $tsparms{tdepth} = $self->{depth} if defined $self->{depth}; - $tsparms{tcount} = $self->{count} if defined $self->{count}; - foreach (qw(headers chain head_include)) { - $tsparms{$_} = $self->{$_} if defined $self->{$_}; - } - } - - # Abracadabra - my $ts = HTML::TableExtract::TableState->new(%tsparms); - - # Inherit lineage - unshift(@{$ts->{lineage}}, @{$pts->{lineage}}) if ref $pts; - - # Chain evolution from parent table state. Once again, however, - # there is no point in passing the chain info along if we are under - # an umbrella. These frames are just *potential* matches from the - # chain. If no match occurs for a particular frame, then that frame - # will simply be passed along to the next generation of table states - # unchanged (assuming elastic behavior has not been disabled). Note: - # frames based on top level constraints, as opposed to chain - # specifications, are formed during TableState instantiation above. - $pts->_spawn_frames($ts) if ref $self->{chain} && !$umbrella && ref $pts; - - # Inform the new table state that there will be no more constraints - # forthcoming. - $ts->_pre_latch; - - # Push the newly created and configured table state onto the - # stack. This will now be the _current_table_state(). - push(@{$self->{_tablestack}}, $ts); -} - -sub _exit_table { - my $self = shift; - my $ts = $self->_current_table_state; - - # Last ditch fix for HTML mangle - $ts->_exit_cell if $ts->{in_cell}; - $ts->_exit_row if $ts->{in_row}; - - if ($ts->_active) { - # Retain our newly captured table, assuming we bothered with it. - $self->_add_table_state($ts); - print STDERR "Captured table ($ts->{depth},$ts->{count})\n" - if $self->{debug} >= 2; - } - - # Restore last table state - pop(@{$self->{_tablestack}}); - --$self->{_in_a_table}; - my $lts = $self->_current_table_state; - if (ref $lts) { - $self->{_cdepth} = $lts->{depth}; - } - else { - # Back to the top level - $self->{_cdepth} = -1; - } - print STDERR "LEAVE: cdepth: $self->{_cdepth}, ccount: $ts->{count}, it: $self->{_in_a_table}\n" if $self->{debug} >= 2; -} - -sub _add_table_state { - my($self, $ts) = @_; - croak "Table state ref required\n" unless ref $ts; - # Preliminary init sweep to appease -w - # - # These undefs would exist for empty <TD> since text() never got - # called. Don't want to blindly do this in a start('td') because - # headers might have vetoed. Also track max row length in case we - # need to pad the other rows in gridmap mode. - my $cmax = 0; - foreach my $r (@{$ts->{content}}) { - $cmax = $#$r if $#$r > $cmax; - foreach (0 .. $#$r) { - $r->[$_] = '' unless defined $r->[$_]; - } - } - # Pad right side of columns if gridmap or header slicing - if ($self->{gridmap}) { - foreach my $r (@{$ts->{content}}) { - grep($r->[$_] = '', $#$r + 1 .. $cmax) if $#$r < $cmax; - } - } - - $self->{_tables}{$ts->{depth}}{$ts->{count}} = $ts; - $self->{_table_mapback}{$ts->{content}} = $ts; - push(@{$self->{_ts_sequential}}, $ts); -} - -sub _current_table_state { - my $self = shift; - $self->{_tablestack}[$#{$self->{_tablestack}}]; -} - -########## - -{ - - package HTML::TableExtract::TableState; - - use strict; - use Carp; - - sub new { - my $that = shift; - my $class = ref($that) || $that; - # Note: 'depth' and 'count' are where this table were found. - # 'tdepth' and 'tcount' are target constraints on which to trigger. - # 'headers' represent a target constraint, location independent. - my $self = { - umbrella => 0, - in_row => 0, - in_cell => 0, - rc => -1, - cc => -1, - frames => [], - content => [], - htxt => '', - order => [], - counts => [{}], - debug => 0, - }; - bless $self, $class; - - my %parms = @_; - - # Depth and Count -- this is the absolute address of the table. - croak "Absolute depth required\n" unless defined $parms{depth}; - croak "Count required\n" unless defined $parms{count}; - - # Inherit count contexts - if ($parms{counts}) { - push(@{$self->{counts}}, @{$parms{counts}}); - delete $parms{counts}; - } - - foreach (keys %parms) { - $self->{$_} = $parms{$_}; - } - - # Register lineage - $self->{lineage} = [ "$self->{depth},$self->{count}" ]; - - # Umbrella is a short circuit. This table and all descendants will - # be harvested if the umbrella parameter was asserted. If it was - # not, then the initial conditions specified for the new table - # state are passed along as the first frame in the chain. - if (!$self->{umbrella}) { - # Frames are designed to be used when chains are specified. With - # no chains specified, there is only a single frame, the global - # frame, so frames become a bit redundant. We use the mechanisms - # anyway for consistency in the extraction engine. Each frame - # contains information that might be relative to a chain - # frame. Currently this means depth, count, and headers. - my %frame; - # Frame depth and count represent target depth and count, in - # absolute terms. If present, our initial frame takes these from - # the target values in the table state. Unlike frames generated - # by chains, the counts hash for the initial frame comes from - # the global level (this is necessary since the top-level HTML - # document has no table state from which to inherit!). Counts - # relative to this frame will be assigned and updated based on - # chain links, assuming there are any. - $frame{depth} = $self->{tdepth} if exists $self->{tdepth}; - $frame{count} = $self->{tcount} if exists $self->{tcount}; - $frame{headers} = $self->{headers} if exists $self->{headers}; - $frame{counts} = $self->{counts}[$#{$self->{counts}}]; - $frame{global} = 1; - $frame{terminus} = 1 if $self->{keep}; - $frame{heritage} = "($self->{depth},$self->{count})"; - $self->_add_frame(\%frame); - } - else { - # Short circuit since we are an umbrella. Activate table state. - $self->{active} = 1; - } - $self; - } - - sub _text_hungry { - # Text hungry only means that we are interested in gathering the - # text, whether it be for header scanning or harvesting. - my $self = shift; - return 1 if $self->{umbrella}; - return 0 if $self->{prune}; - $self->_any_dctrigger; - } - - sub _taste_text { - # Gather the provided text, either for header scanning or - # harvesting. - my($self, $text) = @_; - - # Calculate and track skew, regardless of whether we actually want - # this column or not. - my $sc = $self->_skew; - - # Harvest if trigger conditions have been met in a terminus - # frame. If headers have been found, and we are not beneath a - # header column, then ignore this text. - if ($self->_terminus_trigger && $self->_column_wanted || - $self->{umbrella}) { - if (defined $text) { # -w appeasement - print STDERR "Add text '$text'\n" if $self->{debug} > 3; - $self->_add_text($text, $sc); - } - } - # Regardless of whether or not we are harvesting, we still try to - # scan for headers in waypoint frames. - if (defined $text && $self->_any_headers && !$self->_any_htrigger) { - $self->_htxt($text); - } - 1; - } - - ### Init - - sub _pre_latch { - # This should be called at some point soon after object creation - # to inform the table state that there will be no more constraints - # added. This way latches can be pre-set if possible for - # efficiency. - my $self = shift; - - $self->_trigger_frames; - return 0 if $self->{prune}; - - if ($self->{umbrella}) { - ++$self->{dc_trigger}; - ++$self->{head_trigger}; - ++$self->{trigger}; - ++$self->{active}; - return; - } - # The following latches are detectable immediately for a - # particular table state. - $self->_terminus_dctrigger; - $self->_any_dctrigger; - $self->_terminus_headers; - $self->_any_headers; - - } - - ### Latch methods...'terminus' vs 'any' is an important distinction, - ### because conditions might only be satisifed for a waypoint - ### frame. In this case, the next frame in the chain will be - ### created, but the table itself will not be captured. - - sub _terminus_dctrigger { - my $self = shift; - return $self->{terminus_dctrigger} if defined $self->{terminus_dctrigger}; - $self->{terminus_dctrigger} = $self->_check_dctrigger($self->_terminus_frames); - } - - sub _any_dctrigger { - my $self = shift; - return $self->{any_dctrigger} if defined $self->{any_dctrigger}; - $self->{any_dctrigger} = $self->_check_dctrigger(@{$self->{frames}}); - } - - sub _terminus_headers { - my $self = shift; - return $self->{terminus_headers} if defined $self->{terminus_headers}; - $self->{terminus_headers} = $self->_check_headers($self->_terminus_frames); - } - - sub _any_headers { - my $self = shift; - return $self->{any_headers} if defined $self->{any_headers}; - $self->{any_headers} = $self->_check_headers(@{$self->{frames}}); - } - - sub _terminus_htrigger { - # Unlike depth and count, this trigger should only latch on - # positive values since each row is to be examined. - my $self = shift; - return $self->{terminus_htrigger} if $self->{terminus_htrigger}; - $self->{terminus_htrigger} = $self->_check_htrigger($self->_terminus_frames); - } - - sub _any_htrigger { - my $self = shift; - return $self->{any_htrigger} if defined $self->{any_htrigger}; - $self->{any_htrigger} = $self->_check_htrigger(@{$self->{frames}}); - } - - sub _terminus_trigger { - # This has to be the same frame reporting on dc/header - # success. First found is the hero. - my $self = shift; - return $self->{terminus_trigger} if $self->{terminus_trigger}; - $self->{terminus_trigger} = $self->_check_trigger($self->_terminus_frames); - } - - sub _any_trigger { - # This has to be the same frame reporting on dc/header - # success. First found is the hero. - my $self = shift; - return $self->{any_trigger} if $self->{any_trigger}; - $self->{any_trigger} = $self->_check_trigger(@{$self->{frames}}); - } - - ### Latch engines - - sub _check_dctrigger { - my($self, @frames) = @_; - return @frames if $self->{umbrella}; - my @dctriggered; - foreach my $f (@frames) { - my $dc_hit = 1; - if ($f->{null}) { - # Special case... - $dc_hit = 0; - } - else { - if (defined $f->{depth} && $f->{depth} != $self->{depth}) { - $dc_hit = 0; - } - elsif (defined $f->{count}) { - $dc_hit = 0; - if (exists $f->{counts}{$self->{depth}} && - $f->{count} == $f->{counts}{$self->{depth}}) { - # Note: frame counts, though relative to chain genesis - # depth, are recorded in terms of absolute depths. A - # particular counts hash is shared among frames descended - # from the same chain instance. - $dc_hit = 1; - } - } - } - push(@dctriggered, $f) if $dc_hit; - } - return @dctriggered ? \@dctriggered : undef; - } - - sub _check_htrigger { - my($self, @frames) = @_; - my @htriggered; - foreach my $f (@frames) { - if ($f->{headers}) { - push(@htriggered, $f) if $f->{head_found}; - } - else { - push(@htriggered, $f); - } - } - @htriggered ? \@htriggered : undef; - } - - sub _check_trigger { - # This has to be the same frame reporting on dc/header - # success. First found is the hero. - my($self, @frames) = @_; - return () unless @frames; - my $tdct = $self->_check_dctrigger(@frames); - my $tht = $self->_check_htrigger(@frames); - my %tframes; - my %tdc_frames; - foreach (ref $tdct ? @$tdct : ()) { - $tdc_frames{$_} = $_; - $tframes{$_} = $_ unless $tframes{$_}; - } - my %th_frames; - foreach (ref $tht ? @$tht : ()) { - $th_frames{$_} = $_; - $tframes{$_} = $_ unless $tframes{$_}; - } - my @frame_order = grep($tframes{$_}, @frames); - my @triggered; - foreach (@frame_order) { - if ($tdc_frames{$_} && $th_frames{$_}) { - push(@triggered, $tframes{$_}); - } - } - @triggered ? \@triggered : undef; - } - - sub _check_headers { - my($self, @frames) = @_; - foreach my $f (@frames) { - return 1 if $f->{headers}; - } - 0; - } - - ### - - sub _terminus_frames { - # Return all frames that are at the end of a chain, or specified - # as a terminus. - my $self = shift; - my @res; - foreach (@{$self->{frames}}) { - push(@res, $_) if $_->{terminus}; - } - @res; - } - - ### - - sub _trigger_frames { - # Trigger each frame whose conditions have been met (i.e., rather - # than merely detect conditions, set state in the affected frame - # as well). - my $self = shift; - if (!@{$self->{frames}}) { - ++$self->{prune}; - return 0; - } - my $t = 0; - foreach my $f (@{$self->{frames}}) { - if ($f->{triggered}) { - ++$t; - next; - } - if ($self->_check_trigger($f)) { - ++$t; - $f->{triggered} = 1; - } - } - $t; - } - - ### Maintain table context - - sub _enter_row { - my $self = shift; - $self->_exit_cell if $self->{in_cell}; - $self->_exit_row if $self->{in_row}; - ++$self->{rc}; - ++$self->{in_row}; - - # Reset next_col for gridmapping - $self->{next_col} = 0; - while ($self->{taken}{"$self->{rc},$self->{next_col}"}) { - ++$self->{next_col}; - } - - ++$self->{active} if $self->_terminus_trigger; - if ($self->{active}) { - # Add the new row, unless we're using headers and are still in - # the header row - push(@{$self->{content}}, []) - unless $self->_terminus_headers && $self->_still_in_header_row; - } - $self->_evolve_frames if $self->_trigger_frames; - } - - sub _exit_row { - my $self = shift; - if ($self->{in_row}) { - $self->_exit_cell if $self->{in_cell}; - $self->{in_row} = 0; - $self->{cc} = -1; - $self->_reset_header_scanners; - if ($self->_terminus_headers && $self->_still_in_header_row) { - ++$self->{hslurp}; - # Store header row number so that we can adjust later (we keep - # it around for now in case of skew situations, which are in - # absolute row terms) - $self->{hrow} = $self->{rc}; - } - } - else { - print STDERR "Mangled HTML in table ($self->{depth},$self->{count}), extraneous </TR> ignored after row $self->{rc}\n" - if $self->{debug}; - } - } - - sub _enter_cell { - my $self = shift; - $self->_exit_cell if $self->{in_cell}; - if (!$self->{in_row}) { - # Go ahead and try to recover from mangled HTML, because we - # care. - print STDERR "Mangled HTML in table ($self->{depth},$self->{count}), inferring <TR> as row $self->{rc}\n" - if $self->{debug}; - $self->_enter_row; - } - ++$self->{cc}; - ++$self->{in_cell}; - } - - sub _exit_cell { - my $self = shift; - if ($self->{in_cell}) { - # Trigger taste_text just in case this was an empty cell. - $self->_taste_text(undef) if $self->_text_hungry; - $self->{in_cell} = 0; - $self->_hmatch; - } - else { - print STDERR "Mangled HTML in table ($self->{depth},$self->{count}), extraneous </TD> ignored in row $self->{rc}\n" - if $self->{debug}; - } - } - - ### - - sub _add_frame { - # Add new frames to this table state. - my($self, @frames) = @_; - return 1 if $self->{umbrella}; - foreach my $f (@frames) { - ref $f or croak "Hash ref required\n"; - - if (! exists $f->{depth} && ! exists $f->{count} && ! $f->{headers}) { - # Special case. If there were no constraints, then umbrella - # gets set. Otherwise, with chains, we want all nodes to - # trigger but not become active due to the potential chain - # constraint. This is just a heads up. - ++$f->{null}; - } - - # Take the opportunity to prune frames that are out of their - # depth. Keep in mind, depths are specified in absolute terms - # for frames, as opposed to relative terms in chains. - if (defined $f->{depth} && $f->{depth} < $self->{depth}) { - print STDERR "Pruning frame for depth $f->{depth} at depth $self->{depth}\n" if $self->{debug} > 2; - next; - } - - # If we are an intermediary in a chain, we will never trigger a - # harvest (well, unless 'keep' was specified, anyway). Avoid - # autovivifying here, because $self->{chain} is used as a test - # many times. - if (ref $self->{chain}) { - if (defined $f->{chaindex} && $f->{chaindex} == $#{$self->{chain}}) { - ++$f->{terminus}; - } - } - elsif ($f->{global}) { - # If there is no chain, the global frame is a terminus. - ++$f->{terminus}; - } - - # Scoop all triggers if keepall has been asserted. - if ($self->{keepall}) { - ++$f->{terminus}; - } - - # Set up header pattern if we have headers. - if ($f->{headers}) { - my $hstring = '(' . join('|', map("($_)", @{$f->{headers}})) . ')'; - print STDERR "HPAT: /$hstring/\n" if $self->{debug} >= 2; - $f->{hpat} = $hstring; - $self->_reset_hits($f); - } - - if ($self->{debug} > 3) { - print STDERR "Adding frame ($f):\n {\n"; - foreach (sort keys %$f) { - next unless defined $f->{$_}; # appease -w - print STDERR " $_ => $f->{$_}\n"; - } - print STDERR " }\n"; - } - - push(@{$self->{frames}}, $f); - } - # Activate header state if there were any header conditions in the - # frames. - $self->_scan_state('headers'); - # Arbitrary true return value. - scalar @{$self->{frames}}; - } - - # Header stuff - - sub _htxt { - # Accumulate or reset header text. This is shared across all - # frames. - my $self = shift; - if (@_) { - if (defined $_[0]) { - $self->{htxt} .= $_[0] if $_[0] !~ /^\s*$/; - } - else { - $self->{htxt} = ''; - } - } - $self->{htxt}; - } - - sub _hmatch { - # Given the current htxt, test all frames for matches. This *will* - # set state in the frames in the event of a match. - my $self = shift; - my @hits; - return 0 unless $self->_any_headers; - foreach my $f (@{$self->{frames}}) { - next unless $f->{hpat}; - if ($self->{htxt} =~ /$f->{hpat}/im) { - my $hit = $1; - print STDERR "HIT on '$hit' in $self->{htxt} ($self->{rc},$self->{cc})\n" if $self->{debug} >= 4; - ++$f->{scanning}; - # Get rid of the header segment that matched so we can tell - # when we're through with all header patterns. - foreach (keys %{$f->{hits_left}}) { - if ($hit =~ /$_/im) { - delete $f->{hits_left}{$_}; - $hit = $_; - last; - } - } - push(@hits, $hit); - # - my $cc = $self->_skew; - $f->{hits}{$cc} = $hit; - push(@{$f->{order}}, $cc); - if (!%{$f->{hits_left}}) { - # We have found all headers for this frame, but we won't - # start slurping until this row has ended - ++$f->{head_found}; - $f->{scanning} = undef; - } - } - } - # Propogate relevant frame states to overall table state. - foreach (qw(head_found scanning)) { - $self->_scan_state($_); - } - # Reset htxt buffer - $self->_htxt(undef); - - wantarray ? @hits : scalar @hits; - } - - # Header and header state booleans - - sub _scan_state { - # This just sets analagous flags on a table state basis - # rather than a frame basis, for testing efficiency to - # reduce the number of method calls involved. - my($self, $state) = @_; - foreach (@{$self->{frames}}) { - ++$self->{$state} if $_->{state}; - } - $self->{$state}; - } - - sub _headers { shift->_check_state('headers' ) } - sub _head_found { shift->_check_state('head_found') } - sub _scanning { shift->_check_state('scanning') } - - # End header stuff - - sub _check_state { - my($self, $state) = @_; - defined $state or croak "State name required\n"; - my @frames_with_state; - foreach my $f (@{$self->{frames}}) { - push(@frames_with_state, $f) if $f->{$state}; - } - return () unless @frames_with_state; - wantarray ? @frames_with_state : $frames_with_state[0]; - } - - # Misc - - sub _evolve_frames { - # Retire frames that were triggered; integrate the next link in - # the chain if available. If it was the global frame, or the frame - # generated from the last in the chain sequence, then activate the - # frame and start a new chain. - my $self = shift; - return if $self->{evolved}; - $self->{newframes} = [] unless $self->{newframes}; - foreach my $f (@{$self->{frames}}) { - # We're only interested in newly triggered frames. - next if !$f->{triggered} || $f->{retired}; - my %new; - if ($self->{chain}) { - if ($f->{global}) { - # We are the global frame, and we have a chain. Spawn a new - # chain. - $new{chaindex} = 0; - # Chain counts are always relative to the table state in - # which frame genisis occurred. Table states inherit the - # count contexts of parent table states, so that they can be - # updated (and therefore descendant frames get updated as - # well). Count contexts are represented as hashes with - # depths as keys. This frame-specific hash is shared amongst - # all frames descended from chains started in this table - # state. - $new{heritage} = "($self->{depth},$self->{count})"; - } - elsif (defined $f->{chaindex}) { - # Generate a new frame based on the next link in the chain - # (unless we are the global frame, in which case we initialize - # a new chain since there is no chain link for the global - # frame). - $new{chaindex} = $f->{chaindex} + 1; - # Relative counts always are inherited from chain genesis. We - # pass by reference so siblings can all update the depth - # counts for that chain. - $new{heritage} = $f->{heritage}; - } - } - - if ($f->{terminus}) { - # This is a hit since we matched either in the global frame, - # the last link of the chain, or in a link specified as a - # keeper. - ++$f->{active} unless $f->{null}; - # If there is a chain, start a new one from this match if it - # was the global frame (if we ever decided to have chains - # spawn chains, this would be the place to do it. Currently - # only the global frame spawns chains). - - } - - # Since we triggered, one way or the other this frame is retired. - ++$f->{retired}; - - # Frames always inherit the count context of the table state in - # which they were created. - $new{counts} = $self->{counts}[0]; - - if (defined $new{chaindex}) { - my $link = $self->{chain}[$new{chaindex}]; - # Tables immediately below the current table state are - # considered depth 0 as specified in chains...hence actual - # depth plus one forms the basis for depth 0 in relative - # terms. - $new{depth} = ($self->{depth} + 1) + $link->{depth} - if exists $link->{depth}; - $new{count} = $link->{count} if exists $link->{count}; - $new{headers} = $link->{headers} if exists $link->{headers}; - ++$new{terminus} if $link->{keep}; - if ($self->{debug} > 3) { - print STDERR "New proto frame (in ts $self->{depth},$self->{count}) for chain rule $new{chaindex}\n"; - print STDERR " {\n"; - foreach (sort keys %new) { - print STDERR " $_ => $new{$_}"; - if ($_ eq 'counts') { - print STDERR " ",join(' ', map("$_,$new{counts}{$_}", - sort { $a <=> $b } keys %{$new{counts}})); - } - print STDERR "\n"; - } - print STDERR " }\n"; - } - push(@{$self->{newframes}}, \%new); - } - - } - # See if we're done evolving our frames. - foreach my $f (@{$self->{frames}}) { - return 0 unless $f->{retired}; - } - # If we are, then flag the whole table state as evolved. - ++$self->{evolved}; - } - - sub _spawn_frames { - # Build and pass new frames to a child table state. This involves - # retiring old frames and passing along untriggered and new - # frames. - my($self, $child) = @_; - ref $child or croak "Child table state required\n"; - if ($self->{umbrella}) { - # Don't mess with frames, just pass the umbrella. - ++$child->{umbrella}; - return; - } - - my @frames; - my @fields = qw(chaindex depth count headers counts heritage terminus); - - foreach my $f (@{$self->{frames}}) { - # Not interested in retired frames (which just matched), root - # frames (which get regenerated each time a frame is created), - # or in unmatched frames when not in elastic mode. - next if !$self->{elastic} || $f->{retired}; - my %new; - foreach (grep(exists $f->{$_}, @fields)) { - $new{$_} = $f->{$_}; - } - push(@frames, \%new); - } - - # Always interested in newly created frames. Make sure and pass - # copies, though, so that siblings don't update each others frame - # sets. - foreach my $f (@{$self->{newframes}}) { - my %new; - foreach (grep(exists $f->{$_}, @fields)) { - $new{$_} = $f->{$_}; - } - push(@frames, \%new); - } - - $child->_add_frame(@frames) if @frames; - } - - # Report methods - - sub depth { shift->{depth} } - sub count { shift->{count} } - sub coords { - my $self = shift; - ($self->depth, $self->count); - } - - sub lineage { - my $self = shift; - map([split(',', $_)], @{$self->{lineage}}); - } - - sub rows { - my $self = shift; - if ($self->{automap} && $self->_map_makes_a_difference) { - my @tc; - my @cm = $self->column_map; - foreach (@{$self->{content}}) { - my $r = [@{$_}[@cm]]; - # since there could have been non-existent <TD> we need - # to double check initilization to appease -w - foreach (0 .. $#$r) { - $r->[$_] = '' unless defined $r->[$_]; - } - push(@tc, $r); - } - return @tc; - } - # No remapping - @{$self->{content}}; - } - - sub column_map { - # Return the column numbers of this table in the same order as the - # provided headers. - my $self = shift; - my $tframes = $self->_terminus_trigger; - my $tframe = ref $tframes ? $tframes->[0] : undef; - if ($tframe && $tframe->{headers}) { - # First we order the original column counts by taking a hash - # slice based on the original header order. The resulting - # original column numbers are mapped to the actual content - # indicies since we could have a sparse slice. - my %order; - foreach (keys %{$tframe->{hits}}) { - $order{$tframe->{hits}{$_}} = $_; - } - return @order{@{$tframe->{headers}}}; - } - else { - return 0 .. $#{$self->{content}[0]}; - } - } - - sub _map_makes_a_difference { - my $self = shift; - my $diff = 0; - my @order = $self->column_map; - my @sorder = sort { $a <=> $b } @order; - ++$diff if $#order != $#sorder; - ++$diff if $#sorder != $#{$self->{content}[0]}; - foreach (0 .. $#order) { - if ($order[$_] != $sorder[$_]) { - ++$diff; - last; - } - } - $diff; - } - - sub _add_text { - my($self, $txt, $skew_column) = @_; - # We don't check for $txt being defined, sometimes we want to - # merely insert a placeholder in the content. - my $row = $self->{content}[$#{$self->{content}}]; - if (! defined $row->[$skew_column]) { - # Init to appease -w - $row->[$skew_column] = ''; - } - return unless defined $txt; - $row->[$skew_column] .= $txt; - $txt; - } - - sub _skew { - # Skew registers the effects of rowspan/colspan issues when - # gridmap is enabled. - - my($self, $rspan, $cspan) = @_; - my($r,$c) = ($self->{rc},$self->{cc}); - - if ($self->{debug} > 5) { - print STDERR "($self->{rc},$self->{cc}) Inspecting skew for ($r,$c)"; - print STDERR defined $rspan ? " (set with $rspan,$cspan)\n" : "\n"; - } - - my $sc = $c; - if (! defined $self->{skew_cache}{"$r,$c"}) { - $sc = $self->{next_col} if defined $self->{next_col}; - $self->{skew_cache}{"$r,$c"} = $sc; - my $next_col = $sc + 1; - while ($self->{taken}{"$r,$next_col"}) { - ++$next_col; - } - $self->{next_col} = $next_col; - } - else { - $sc = $self->{skew_cache}{"$r,$c"}; - } - - # If we have span arguments, set skews - if (defined $rspan) { - # Default span is always 1, even if not explicitly stated. - $rspan = 1 unless $rspan; - $cspan = 1 unless $cspan; - --$rspan; - --$cspan; - # 1,1 is a degenerate case, there's nothing to do. - if ($rspan || $cspan) { - foreach my $rs (0 .. $rspan) { - my $cr = $r + $rs; - # If we in the same row as the skewer, the "span" is one less - # because the skewer cell occupies the same row. - my $start_col = $rs ? $sc : $sc + 1; - my $fin_col = $sc + $cspan; - foreach ($start_col .. $fin_col) { - $self->{taken}{"$cr,$_"} = "$r,$sc" unless $self->{taken}{"$cr,$_"}; - } - if (!$rs) { - my $next_col = $fin_col + 1; - while ($self->{taken}{"$cr,$next_col"}) { - ++$next_col; - } - $self->{next_col} = $next_col; - } - } - } - } - - # Grid column number - $sc; - } - - sub _reset_header_scanners { - # When a row ends, this should be called in order to reset frames - # who are in the midst of header scans. - my $self = shift; - my @scanners; - foreach my $f (@{$self->{frames}}) { - next unless $f->{headers} && $f->{scanning}; - if ($self->{debug}) { - my $str = "Incomplete header match in row $self->{rc}, resetting scan"; - $str .= " link $f->{chaindex}" if defined $f->{chaindex}; - $str .= "\n"; - print STDERR $str; - } - push(@scanners, $f); - } - $self->_reset_hits(@scanners) if @scanners; - } - - sub _header_quest { - # Loosely translated: "Should I even bother scanning for header - # matches?" - my $self = shift; - return 0 unless $self->_any_headers && !$self->_head_found; - foreach my $f (@{$self->{frames}}) { - return 1 if $f->{headers} && $f->{dc_trigger}; - } - 0; - } - - sub _still_in_header_row { - my $self = shift; - return 0 unless $self->_terminus_headers; - !$self->{hslurp} && $self->_terminus_htrigger; - } - - # Non waypoint answers - - sub _active { - my $self = shift; - return 1 if $self->{active}; - my @active; - foreach my $f (@{$self->{frames}}) { - push(@active, $f) if $f->{active}; - } - return () unless @active; - ++$self->{active} if @active; - wantarray ? @active : $active[0]; - } - - sub _column_wanted { - my $self = shift; - my $tframes = $self->_terminus_trigger; - my $tframe = ref $tframes ? $tframes->[0] : undef; - return 0 unless $tframe; - my $wanted = 1; - if ($self->_terminus_headers && $self->{hslurp}) { - # If we are using headers, veto the grab unless we are in an - # applicable column beneath one of the headers. - $wanted = 0 - unless exists $tframe->{hits}{$self->_skew}; - } - print STDERR "Want ($self->{rc},$self->{cc}): $wanted\n" - if $self->{debug} > 7; - $wanted; - } - - sub _reset_hits { - # Reset hits in provided frames. WARNING!!! If you do not provide - # frames, all frames will be reset! - my($self, @frames) = @_; - foreach my $frame (@frames ? @frames : @{$self->{frames}}) { - next unless $frame->{headers}; - $frame->{hits} = {}; - $frame->{order} = []; - $frame->{scanning} = undef; - foreach (@{$frame->{headers}}) { - ++$frame->{hits_left}{$_}; - } - } - 1; - } - -} - -1; - -__END__ - -=head1 NAME - -HTML::TableExtract - Perl extension for extracting the text contained in tables within an HTML document. - -=head1 SYNOPSIS - - # Matched tables are returned as "table state" objects; tables can be - # matched using column headers, depth, count within a depth, or some - # combination of the three. - - # Using column header information. Assume an HTML document with - # tables that have "Date", "Price", and "Cost" somewhere in a - # row. The columns beneath those headings are what you want to - # extract. They will be returned in the same order as you specified - # the headers since 'automap' is enabled by default. - - use HTML::TableExtract; - $te = new HTML::TableExtract( headers => [qw(Date Price Cost)] ); - $te->parse($html_string); - - # Examine all matching tables - foreach $ts ($te->table_states) { - print "Table (", join(',', $ts->coords), "):\n"; - foreach $row ($ts->rows) { - print join(',', @$row), "\n"; - } - } - - # Old style, using top level methods rather than table state objects. - foreach $table ($te->tables) { - print "Table (", join(',', $te->table_coords($table)), "):\n"; - foreach $row ($te->rows($table)) { - print join(',', @$row), "\n"; - } - } - - # Shorthand...top level rows() method assumes the first table found - # in the document if no arguments are supplied. - foreach $row ($te->rows) { - print join(',', @$row), "\n"; - } - - # Using depth and count information. Every table in the document has - # a unique depth and count tuple, so when both are specified it is a - # unique table. Depth and count both begin with 0, so in this case we - # are looking for a table (depth 2) within a table (depth 1) within a - # table (depth 0, which is the top level HTML document). In addition, - # it must be the third (count 2) such instance of a table at that - # depth. - - $te = new HTML::TableExtract( depth => 2, count => 2 ); - $te->parse($html_string); - foreach $ts ($te->table_states) { - print "Table found at ", join(',', $ts->coords), ":\n"; - foreach $row ($ts->rows) { - print " ", join(',', @$row), "\n"; - } - } - -=head1 DESCRIPTION - -HTML::TableExtract is a subclass of HTML::Parser that serves to -extract the textual information from tables of interest contained -within an HTML document. The text from each extracted table is stored -in tabe state objects which hold the information as an array of arrays -that represent the rows and cells of that table. - -There are three constraints available to specify which tables you -would like to extract from a document: I<Headers>, I<Depth>, and -I<Count>. - -I<Headers>, the most flexible and adaptive of the techniques, involves -specifying text in an array that you expect to appear above the data -in the tables of interest. Once all headers have been located in a row -of that table, all further cells beneath the columns that matched your -headers are extracted. All other columns are ignored: think of it as -vertical slices through a table. In addition, TableExtract -automatically rearranges each row in the same order as the headers you -provided. If you would like to disable this, set I<automap> to 0 -during object creation, and instead rely on the column_map() method to -find out the order in which the headers were found. Furthermore, -TableExtract will automatically compensate for cell span issues so -that columns are really the same columns as you would visually see in -a browser. This behavior can be disabled by setting the I<gridmap> -parameter to 0. HTML is stripped from the entire textual content of a -cell before header matches are attempted -- unless the I<keep_html> -parameter was enabled. - -I<Depth> and I<Count> are more specific ways to specify tables in -relation to one another. I<Depth> represents how deeply a table -resides in other tables. The depth of a top-level table in the -document is 0. A table within a top-level table has a depth of 1, and -so on. Each depth can be thought of as a layer; tables sharing the -same depth are on the same layer. Within each of these layers, -I<Count> represents the order in which a table was seen at that depth, -starting with 0. Providing both a I<depth> and a I<count> will -uniquely specify a table within a document. - -Each of the I<Headers>, I<Depth>, and I<Count> specifications are -cumulative in their effect on the overall extraction. For instance, if -you specify only a I<Depth>, then you get all tables at that depth -(note that these could very well reside in separate higher-level -tables throughout the document since depth extends across tables). If -you specify only a I<Count>, then the tables at that I<Count> from all -depths are returned (i.e., the I<n>th occurrence of a table at each -depth). If you only specify I<Headers>, then you get all tables in the -document containing those column headers. If you have specified -multiple constraints of I<Headers>, I<Depth>, and I<Count>, then each -constraint has veto power over whether a particular table is -extracted. - -If no I<Headers>, I<Depth>, or I<Count> are specified, then all -tables match. - -Text that is gathered from the tables is decoded with HTML::Entities -by default; this can be disabled by setting the I<decode> parameter to -0. - -=head2 Chains - -Make sure you fully understand the notions of I<depth> and I<count> -before proceeding, because it is about to become a bit more involved. - -Table matches using I<Headers>, I<Depth>, or I<Count> can be chained -together in order to further specify tables relative to one -another. Links in chains are successively applied to tables within -tables. Top level constraints (i.e., I<header>, I<depth>, and I<count> -parameters for the TableExtract object) behave as the first link in -the chain. Additional links are specified using the I<chain> -parameter. Each link in the chain has its own set of constraints. For -example: - - $te = new HTML::TableExtract - ( - headers => [qw(Summary Region)], - chain => [ - { depth => 0, count => 2 }, - { headers => [qw(Part Qty Cost)] } - ], - ); - -The matching process in this case will start with B<all> tables in the -document that have "Summary" and "Region" in their headers. For now, -assume that there was only one table that matched these headers. Each -table contained within that table will be compared to the first link -in the chain. Depth 0 means that a matching table must be immediately -contained within the current table; count 2 means that the matching -table must also be the third at that depth (counts and depths start at -0). In other words, the next link of the chain will match on the -third table immediately contained within our first matched table. Once -this link matches, then B<all> further tables beneath that table that -have "Part", "Qty", and "Cost" in their headers will match. By -default, it is only tables at the end of the chains that are returned -to the application, so these tables are returned. - -Each time a link in a chain matches a table, an additional context for -I<depth> and I<count> is established. It is perhaps easiest to -visualize a I<context> as a brand-new HTML document, with new depths -and counts to compare to the remaining links in the chain. The top -level HTML document is the first context. Each table in the document -establishes a new context. I<Depth> in a chain link is relative to the -context that the matching table creates (i.e., a link depth of 0 would -be a table immediately contained within the table that matched the -prior link in the chain). Likewise, that same context keeps track of -I<counts> within the new depth scheme for comparison to the remaining -links in the chain. Headers still apply if they are present in a link, -but they are always independent of context. - -As it turns out, specifying a depth and count provides a unique -address for a table within a context. For non-unique constraints, such -as just a depth, or headers, there can be multiple matches for a given -link. In these cases the chain "forks" and attempts to make further -matches within each of these tables. - -By default, chains are I<elastic>. This means that when a particular -link does not match on a table, it is passed down to subtables -unchanged. For example: - - $te = new HTML::TableExtract - ( - headers => [qw(Summary Region)], - chain => [ - { headers => [qw(Part Qty Cost)] } - ], - ); - -If there are intervening tables between the two header queries, they -will be ignored; this query will extract all tables with "Part", -"Qty", and "Cost" in the headers that are contained in any table with -"Summary" and "Region" in its headers, regardless of how embedded the -inner tables are. If you want a chain to be inelastic, you can set the -I<elastic> parameter to 0 for the whole TableExtract object. Using the -same example: - - $te = new HTML::TableExtract - ( - headers => [qw(Summary Region)], - chain => [ - { headers => [qw(Part Qty Cost)] } - ], - elastic => 0, - ); - -In this case, the inner table (Part, Qty, Cost) must be B<immediately> -contained within the outer table (Summary, Region) in order for the -match to take place. This is equivalent to specifying a depth of 0 for -each link in the chain; if you only want particular links to be -inelastic, then simply set their depths to 0. - -By default, only tables that match at the end of the chains are -retained. The intermediate matches along the chain are referred to as -I<waypoints>, and are not extracted by default. A waypoint may be -retained, however, by specifiying the I<keep> parameter in that link -of the chain. This parameter may be specified at the top level as well -if you want to keep tables that match the first set of constraints in -the object. If you want to keep all tables that match along the chain, -the specify the I<keepall> parameter at the top level. - -Are chains overkill? Probably. In reality, nested HTML tables tend not -to be very deep, so there will usually not be much need for lots of -links in a chain. Theoretically, however, chains offer precise -targeting of tables relative to one another, no matter how deeply -nested they are. - -=head2 Pop Quiz - -What happens with the following table extraction? - - $te = new HTML::TableExtract( - chain => [ { depth => 0 } ], - ); - -Answer: All tables that are contained in another table are extracted -from the document. In this case, there were no top-level constraints -specified, which if you recall means that B<all> tables match the -first set of constraints (or non-constraints, in this case!). A depth -of 0 in the next link of the chain means that the matching table must -be immediately contained within the table from a prior match. - -The following is equivalent: - - $te = new HTML::TableExtract( - depth => 1, - subtables => 1, - ) - -The I<subtables> parameter tells TableExtract to scoop up all tables -contained within the matching tables. In conjunction with a depth of -1, this has the affect of discarding all top-level tables in the -document, which is exactly what occurred in the prior example. - -=head2 Advice - -The main point of this module was to provide a flexible method of -extracting tabular information from HTML documents without relying to -heavily on the document layout. For that reason, I suggest using -I<Headers> whenever possible -- that way, you are anchoring your -extraction on what the document is trying to communicate rather than -some feature of the HTML comprising the document (other than the fact -that the data is contained in a table). - -HTML::TableExtract is a subclass of HTML::Parser, and as such inherits -all of its basic methods. In particular, C<start()>, C<end()>, and -C<text()> are utilized. Feel free to override them, but if you do not -eventually invoke them in the SUPER class with some content, results -are not guaranteed. - -=head1 METHODS - -The following are the top-level methods of the HTML::TableExtract -object. Tables that have matched a query are actually returned as -separate objects of type HTML::TableExtract::TableState. These table -state objects have their own methods, documented further below. There -are some top-level methods that are present for convenience and -backwards compatibility that are nothing more than front-ends for -equivalent table state methods. - -=over - -=head2 Constructor - -=item new() - -Return a new HTML::TableExtract object. Valid attributes are: - -=over - -=item headers - -Passed as an array reference, headers specify strings of interest at -the top of columns within targeted tables. These header strings will -eventually be passed through a non-anchored, case-insensitive regular -expression, so regexp special characters are allowed. The table row -containing the headers is B<not> returned. Columns that are not -beneath one of the provided headers will be ignored. Columns will, by -default, be rearranged into the same order as the headers you provide -(see the I<automap> parameter for more information). Additionally, by -default columns are considered what you would see visually beneath -that header when the table is rendered in a browser. See the -I<gridmap> parameter for more information. HTML within a header is -stripped before the match is attempted, unless the B<keep_html> -parameter was specified. - -=item depth - -Specify how embedded in other tables your tables of interest should -be. Top-level tables in the HTML document have a depth of 0, tables -within top-level tables have a depth of 1, and so on. - -=item count - -Specify which table within each depth you are interested in, beginning -with 0. - -=item chain - -List of additional constraints to be matched sequentially from the top -level constraints. This is a reference to an array of hash -references. Each hash is a link in the chain, and can be specified in -terms of I<depth>, I<count>, and I<headers>. Further modifiers include -I<keep>, which means to retain the table if it would normally be -dropped as a waypoint. - -=item automap - -Automatically applies the ordering reported by column_map() to the -rows returned by rows(). This only makes a difference if you have -specified I<Headers> and they turn out to be in a different order in -the table than what you specified. Automap will rearrange the columns -in the same order as the headers appear. To get the original ordering, -you will need to take another slice of each row using -column_map(). I<automap> is enabled by default. - -=item gridmap - -Controls whether the table contents are returned as a grid or a -tree. ROWSPAN and COLSPAN issues are compensated for, and columns -really are columns. Empty phantom cells are created where they would -have been obscured by ROWSPAN or COLSPAN settings. This really becomes -an issue when extracting columns beneath headers. Enabled by default. - -=item keepall - -Keep all tables that matched along a chain, including tables matched -by top level contraints. By default, waypoints are dropped and only -the matches at the end of the chain are retained. To retain a -particular waypoint along a chain, use the I<keep> parameter in that -link. - -=item elastic - -When set to 0, all links in chains will be treated as though they had -a depth of 0 specified, which means there can be no intervening -unmatched tables between matches on links. - -=item subtables - -Extract all tables within matched tables. - -=item decode - -Automatically decode retrieved text with -HTML::Entities::decode_entities(). Enabled by default. - -=item br_translate - -Translate tags into newlines. Sometimes the remaining text can be -hard to parse if the tag is simply dropped. Enabled by default. -Has no effect if I<keep_html> is enabled. - -=item keep_html - -Return the raw HTML contained in the cell, rather than just the -visible text. Embedded tables are B<not> retained in the HTML -extracted from a cell. Patterns for header matches must take into -account HTML in the string if this option is enabled. - -=item debug - -Prints some debugging information to STDOUT, more for higher values. - -=back - -=head2 Regular Methods - -=item depths() - -Returns all depths that contained matched tables in the document. - -=item counts($depth) - -For a particular depth, returns all counts that contained matched -tables. - -=item table_state($depth, $count) - -For a particular depth and count, return the table state object for -the table found, if any. - -=item table_states() - -Return table state objects for all tables that matched. - -=item first_table_state_found() - -Return the table state object for the first table matched in the -document. - -=head2 TABLE STATE METHODS - -The following methods are invoked from an -HTML::TableExtract::TableState object, such as those returned from the -C<table_states()> method. - -=item rows() - -Return all rows within a matched table. Each row returned is a -reference to an array containing the text of each cell. - -=item depth() - -Return the (absolute) depth at which this table was found. - -=item count() - -Return the count for this table within the depth it was found. - -=item coords() - -Return depth and count in a list. - -=item column_map() - -Return the order (via indices) in which the provided headers were -found. These indices can be used as slices on rows to either order the -rows in the same order as headers or restore the rows to their natural -order, depending on whether the rows have been pre-adjusted using the -I<automap> parameter. - -=item lineage() - -Returns the path of matched tables that led to matching this -table. Lineage only makes sense if chains were used. Tables that were -not matched by a link in the chain are not included in lineage. The -lineage path is a list of array refs containing depth and count values -for each table involved. - -=head2 Procedural Methods - -The following top level methods are alternatives to invoking methods -in a table state object. If you do not want to deal with table state -objects, then these methods are for you. The "tables" they deal in are -actually just arrays of arrays, which happen to be the current -internal data structure of the table state objects. They are here for -backwards compatibility. - -=item table($depth, $count) - -Same as C<table_state()>, but returns the internal data structure -rather than the table state object. - -=item tables() - -Same as C<table_states()>, but returns the data structures rather than -the table state objects. - -=item first_table_found() - -Same as C<first_table_state_found()>, except returns the data -structure for first table that matched. - -=item table_coords($table) - -Returns the depth and count for a particular table data structure. See -the C<coords()> method provided by table state objects. - -=item rows() - -=item rows($table) - -Return a lsit of the rows for a particular table data structure (first -table found by default). See the C<rows()> method provided by table -state objects. - -=item column_map() - -=item column_map($table) - -Return the column map for a particular table data structure (first -found by default). See the C<column_map()> method provided by table -state objects. - -=back - -=head1 REQUIRES - -HTML::Parser(3), HTML::Entities(3) - -=head1 AUTHOR - -Matthew P. Sisk, E<lt>F<sisk(a)mojotoad.com>E<gt> - -=head1 COPYRIGHT - -Copyright (c) 2000-2002 Matthew P. Sisk. -All rights reserved. All wrongs revenged. This program is free -software; you can redistribute it and/or modify it under the -same terms as Perl itself. - -=head1 SEE ALSO - -HTML::Parser(3), perl(1). - -=cut - -In honor of fragmented markup languages and sugar mining: - -The Good and The Bad -Ted Hawkins (1936-1994) - -Living is good - when you have someone to share it with -Laughter is bad - when there is no one there to share it with -Talking is sad - if you've got no one to talk to -Dying is good - when the one you love grows tired of you - -Sugar is no good - once it's cast among the white sand -What the point - in pulling the gray hairs from among the black strands -When you're old - you shouldn't walk in the fast lane -Oh ain't it useless - to keep trying to draw true love from that man - -He'll hurt you, - Yes just for the sake of hurting you -and he'll hate you - if you try to love him just the same -He'll use you - and everything you have to offer him -On your way girl - Get out and find you someone new diff --git a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/test.pl b/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/test.pl deleted file mode 100644 index db0b89c..0000000 --- a/monitoring/PerlModules/CPAN/HTML-TableExtract-1.08/test.pl +++ /dev/null @@ -1,607 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl test.pl' - -######################### We start with some black magic to print on failure. - -# Change 1..1 below to 1..last_test_to_print . -# (It may become useful if the test is moved to ./t subdirectory.) - -BEGIN { $| = 1; print "1..22\n"; } -END {print "not ok 1\n" unless $loaded;} -use HTML::TableExtract; -$loaded = 1; -print "ok 1 (load)\n"; - -######################### End of black magic. - -# Init test count -$tcount = 2; - -# For dataset 'chain' -%CHAIN_DATA = ( - bulk => [ [3,0],[3,1],[2,0],[3,2],[3,3],[2,1],[1,0], - [3,4],[3,5],[2,2],[3,6],[3,7],[2,3],[1,1],[0,0] ], - d2cd1a => [ [3,0],[3,1],[3,2],[3,3],[3,4],[3,5],[3,6],[3,7] ], - d2cd1b => [ [3,0],[3,1],[3,2],[3,3],[1,0],[3,4],[3,5],[3,6],[3,7],[1,1] ], - c2cc1a => [ [3,3],[3,5],[2,3] ], - c2cc1b => [ [3,1],[3,3],[2,1],[3,5],[2,3],[1,1] ], - h2ch1a => [ [3,1],[2,1],[1,1] ], - h2ch1b => [ [3,1],[2,1],[1,1],[0,0] ], - d2cd2 => [ [3,0],[3,1],[3,2],[3,3],[1,0],[3,4],[3,5],[3,6],[3,7],[1,1] ], - c2cc2 => [ [3,0],[2,0],[3,3],[1,0],[3,5],[2,3],[0,0] ], - h2ch2 => [ [3,2],[3,3],[2,2],[2,3],[0,0] ], - c2cc3 => [ [3,0],[2,0],[3,3],[1,0],[2,3],[0,0] ], - h2ch3 => [ [2,2],[2,3],[0,0] ], - h2ch4 => [ [3,1],[3,2],[3,3],[2,1],[2,2],[2,3],[1,1],[0,0] ], - d2h2c => [ [3,3] ], - ); - -# For dataset 'chain' -@LINEAGE_DATA = ( - [ "0,0", "1,0", "2,0", "3,0" ], - [ "0,0", "1,0", "2,0", "3,1" ], - [ "0,0", "1,0", "2,0" ], - [ "0,0", "1,0", "2,1", "3,2" ], - [ "0,0", "1,0", "2,1", "3,3" ], - [ "0,0", "1,0", "2,1" ], - [ "0,0", "1,0" ], - [ "0,0", "1,1", "2,2", "3,4" ], - [ "0,0", "1,1", "2,2", "3,5" ], - [ "0,0", "1,1", "2,2" ], - [ "0,0", "1,1", "2,3", "3,6" ], - [ "0,0", "1,1", "2,3", "3,7" ], - [ "0,0", "1,1", "2,3" ], - [ "0,0", "1,1" ], - [ "0,0" ] - ); - -# For data set 'basic' -@headers = ( - 'Header Zero', - 'Header One', - 'Header Two', - 'Header Three', - 'Header Four', - 'Header Five', - 'Header Six', - 'Header Seven', - 'Header Eight', - 'Header Nine', - ); - -# For data set 'skew' -@SKEW_DATA = ( - [ 'THIS IS A WHOLE ROW-CELL OF JUNK','','','' ], - [ 'JUNK','Tasty tidbit (1,1)','JUNK','Tasty tidbit (1,3)' ], - [ '',"BIG\nJUNK",'','Tasty tidbit (2,3)' ], - [ 'Tasty tidbit (3,0)','','','Tasty tidbit (3,3)' ], - [ 'Tasty tidbit (4,0)','','','Tasty tidbit (4,3)' ], - [ 'JUNK BUTTON','','Tasty tidbit (5,2)','Tasty tidbit (5,3)' ], - ); - -# Constructs array called @docs -eval join('', <DATA>) or die $@; - -$html = $docs{chain}; - -# By bulk, lineage integrity -$pass = 1; -$te = new HTML::TableExtract(); -$te->parse($html); -$label = 'bulk'; -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -foreach $tsc (0 .. $#tablestates) { - $ts = $tablestates[$tsc]; - foreach (0 .. $#{$ts->{lineage}}) { - $pass = 0 unless $ts->{lineage}[$_] eq $LINEAGE_DATA[$tsc][$_]; - } -} -print $pass ? "ok " : "not ok "; -printf "%2d (by bulk with lineage check)\n", $tcount; -++$tcount; - -$html = $docs{basic}; - -# By count -$pass = 1; -$te = new HTML::TableExtract( - count => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 2; -foreach (@tablestates) { - $pass = 0 unless good_data($_); -} -print $pass ? "ok " : "not ok "; -printf "%2d (by count)\n", $tcount; -++$tcount; - -# By depth -$pass = 1; -$te = new HTML::TableExtract( - depth => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 2; -foreach (@tablestates) { - $pass = 0 unless good_data($_); -} -print $pass ? "ok " : "not ok "; -printf "%2d (by depth)\n", $tcount; -++$tcount; - -# By header -$pass = 1; -$te = new HTML::TableExtract( - headers => [qw(Eight Six Four Two Zero)], - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 5; -foreach (@tablestates) { - $pass = 0 unless good_data($_); -} - -print $pass ? "ok " : "not ok "; -printf "%2d (by header)\n", $tcount; -++$tcount; - -# By depth and count -$pass = 1; -$te = new HTML::TableExtract( - depth => 0, - count => 2, - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 1; -foreach (@tablestates) { - $pass = 0 unless good_data($_); -} - -print $pass ? "ok " : "not ok "; -printf "%2d (by depth and count)\n", $tcount; -++$tcount; - -# By subtable scoop -$pass = 1; -$te = new HTML::TableExtract( - depth => 0, - count => 2, - subtables => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 3; -foreach (@tablestates) { - $pass = 0 unless good_data($_); -} - -print $pass ? "ok " : "not ok "; -printf "%2d (by depth and count, subtable scoop)\n", $tcount; -++$tcount; - -# Advanced header extraction. Test skew and column mapping. -$html = $docs{skew}; - -# Column skew -$pass = 1; -$te = new HTML::TableExtract( - headers => [ qw(head0 head1 head2 head3) ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 1; -$pass = 0 unless good_skew_data($tablestates[0]); -print $pass ? "ok " : "not ok "; -printf "%2d (by header with span correction)\n", $tcount; -++$tcount; - -# Column skew and column mapping -$pass = 1; -$te = new HTML::TableExtract( - headers => [ qw(head3 head2 head1 head0) ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$pass = 0 unless @tablestates == 1; -$pass = 0 unless good_skew_data($tablestates[0], 'reverse'); -print $pass ? "ok " : "not ok "; -printf "%2d (by header with column mapping)\n", $tcount; -++$tcount; - -# Chaining tests -$html = $docs{chain}; - -# Depth to depth chaining -$pass = 1; -$te = new HTML::TableExtract( - depth => 1, - chain => [ - { depth => 1 } - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'd2cd1a'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by depth to chain depth)\n", $tcount; -++$tcount; - -# Depth to depth chaining, keep global -$pass = 1; -$te = new HTML::TableExtract( - depth => 1, - keep => 1, - chain => [ - { depth => 1 } - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'd2cd1b'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by depth to chain depth, retain global)\n", $tcount; -++$tcount; - -# Count to count chaining -$pass = 1; -$te = new HTML::TableExtract( - count => 1, - chain => [ - { count => 1 } - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'c2cc1a'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by count to chain count)\n", $tcount; -++$tcount; - -# Count to count chaining, keep global -$pass = 1; -$te = new HTML::TableExtract( - count => 1, - keep => 1, - chain => [ - { count => 1 } - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'c2cc1b'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by count to chain count, retain global)\n", $tcount; -++$tcount; - -# Header to header chaining -# Note: this should demonstrate the "bug" of not matching subtables until -# a complete header match is obtained... -$pass = 1; -$te = new HTML::TableExtract( - headers => [ '0,0: $0,0$', '0,0: $0,1$' ], - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] } - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'h2ch1a'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by header to chain header)\n", $tcount; -++$tcount; - -# Header to header chaining, keep global -# Note: this should demonstrate the "bug" of not matching subtables until -# a complete header match is obtained... -$pass = 1; -$te = new HTML::TableExtract( - headers => [ '0,0: $0,0$', '0,0: $0,1$' ], - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] } - ], - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'h2ch1b'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by header to chain header, retain global)\n", $tcount; -++$tcount; - -# Depth to waypoint depth to terminus depth chaining -$pass = 1; -$te = new HTML::TableExtract( - depth => 1, - chain => [ - { depth => 0 }, - { depth => 0 } - ], - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'd2cd2'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by depth to chain depth with depth waypoint, retain global)\n", $tcount; -++$tcount; - -# Count to count waypoint to count terminus chaining -$pass = 1; -$te = new HTML::TableExtract( - count => 0, - chain => [ - { count => 1 }, - { count => 1 } - ], - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'c2cc2'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by count to chain count with count waypoint, retain global)\n", $tcount; -++$tcount; - -# Header to header waypoint to header terminus chaining -$pass = 1; -$te = new HTML::TableExtract( - headers => [ '0,0: $0,0$', '0,0: $0,1$' ], - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] }, - { headers => [ '$0,0$', '$0,1$' ] } - ], - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'h2ch2'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by header to chain header with header waypoint, retain global)\n", $tcount; -++$tcount; - -# Count to count waypoint to count terminus chaining, non-elastic -$pass = 1; -$te = new HTML::TableExtract( - count => 0, - chain => [ - { count => 1 }, - { count => 1 } - ], - elastic => 0, - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'c2cc3'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by count to chain count with count waypoint, non-elastic, retain global)\n", $tcount; -++$tcount; - -# Header to header waypoint to header terminus chaining, non-elastic -$pass = 1; -$te = new HTML::TableExtract( - headers => [ '0,0: $0,0$', '0,0: $0,1$' ], - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] }, - { headers => [ '$0,0$', '$0,1$' ] } - ], - elastic => 0, - keep => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'h2ch3'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by header to chain header with header waypoint, non-elastic, retain global)\n", $tcount; -++$tcount; - -# Header to header waypoint to header terminus chaining, keep all waypoints -$pass = 1; -$te = new HTML::TableExtract( - headers => [ '0,0: $0,0$', '0,0: $0,1$' ], - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] }, - { headers => [ '$0,0$', '$0,1$' ] } - ], - keepall => 1, - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'h2ch4'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by header to chain header with header waypoint, retain all waypoints)\n", $tcount; -++$tcount; - -# Depth to header waypoint to count terminus -$pass = 1; -$te = new HTML::TableExtract( - depth => 1, - chain => [ - { headers => [ '1: $0,0$', '1: $0,1$' ] }, - { count => 1 }, - ], - ); -$te->parse($html); -@tablestates = $te->table_states; -$label = 'd2h2c'; -$pass = 0 unless @tablestates == @{$CHAIN_DATA{$label}}; -$pass = 0 unless good_chain_data($te, $label); -print $pass ? "ok " : "not ok "; -printf "%2d (by depth to count, header waypoint)\n", $tcount; -++$tcount; - -exit; - -sub good_data { - my $ts = shift; - ref $ts or die "Oops: Table state ref required\n"; - my $t = $ts->{content}; - my $skew; - if ($t->[0][0] =~ /^Header/) { - $skew = 1; - } - else { - $skew = 0; - } - my $row = 0 + $skew; - - # Must have rows - return 0 unless @{$t}; - - # See if we got the numbers. - foreach my $r ($row .. $#$t) { - # Must have columns - return 0 unless @{$t->[$r]}; - foreach my $c (0 .. $#{$t->[$r]}) { - my $rc = $skew ? $r : $r + 1; - next if $ts->{headers} && !$ts->{hits}{$c}; - $t->[$r][$c] =~ /^ $$rc,$c$$/ or return 0; - } - } - - # Header order check - if ($skew) { - foreach my $c (0 .. $#{$t->[0]}) { - my $hs = $headers[$c]; - $t->[0][$c] =~ /^$hs$/ or return 0; - } - } - 1; -} - -sub good_skew_data { - my($ts, $reverse) = @_; - ref $ts or die "Oops: Table state ref required\n"; - my $t = $ts->{content}; - foreach my $r (0 .. $#$t) { - my @cols = 0 .. $#{$t->[$r]}; - @cols = reverse @cols if $reverse; - foreach my $c (@cols) { - return 0 unless $t->[$r][$c] eq $SKEW_DATA[$r][$c]; - } - } - 1; -} - -sub good_chain_data { - my($te, $key) = @_; - ref $te or die "Oops: TableExtract object required\n"; - $CHAIN_DATA{$key} or die "Oops: Valid CHAIN_DATA key required\n"; - my $coord_list = [map([$_->depth,$_->count], $te->table_states)]; - my $data = $CHAIN_DATA{$key}; -# print 'clist: ',join(',', map('[' . join(',', @$_) . ']', @$coord_list)),"\n"; -# print 'dlist: ',join(',', map('[' . join(',', @$_) . ']', @$data)),"\n"; - @$coord_list == @$data or return 0; -# print scalar @$coord_list, " in both lists\n"; - foreach (0 .. $#{$coord_list}) { -# print "comp cl[$_][0]:$coord_list->[$_][0] to dl[$_][0]:$data->[$_][0]\n"; - $coord_list->[$_][0] == $data->[$_][0] or return 0; -# print "comp cl[$_][1]:$coord_list->[$_][1] to dl[$_][1]:$data->[$_][1]\n"; - $coord_list->[$_][1] == $data->[$_][1] or return 0; - } - 1; -} - -__DATA__ -$doc1 = <<__DOC1; -<html> -<head><title>TableExtract Test HTML</title></head> -<body> -<h3>Here lies Table 1:</h3> -<table border=1><tr><td>Header Zero</td><td>Header One</td><td>Header Two</td><td>Header Three</td><td>Header Four</td><td>Header Five</td><td>Header Six</td><td>Header Seven</td><td>Header Eight</td><td>Header Nine</td></tr><tr><td> (1,0)</td><td> (1,1)</td><td> (1,2)</td><td> (1,3)</td><td> (1,4)</td><td> (1,5)</td><td> (1,6)</td><td> (1,7)</td><td> (1,8)</td><td> (1,9)</td></tr><tr><td> (2,0)</td><td> (2,1)</td><td> (2,2)</td><td> (2,3)</td><td> (2,4)</td><td> (2,5)</td><td> (2,6)</td><td> (2,7)</td><td> (2,8)</td><td> (2,9)</td></tr><tr><td> (3,0)</td><td> (3,1)</td><td> (3,2)</td><td> (3,3)</td><td> (3,4)</td><td> (3,5)</td><td> (3,6)</td><td> (3,7)</td><td> (3,8)</td><td> (3,9)</td></tr><tr><td> (4,0)</td><td> (4,1)</td><td> (4,2)</td><td> (4,3)</td><td> (4,4)</td><td> (4,5)</td><td> (4,6)</td><td> (4,7)</td><td> (4,8)</td><td> (4,9)</td></tr><tr><td> (5,0)</td><td> (5,1)</td><td> (5,2)</td><td> (5,3)</td><td> (5,4)</td><td> (5,5)</td><td> (5,6)</td><td> (5,7)</td><td> (5,8)</td><td> (5,9)</td></tr><tr><td> (6,0)</td><td> (6,1)</td><td> (6,2)</td><td> (6,3)</td><td> (6,4)</td><td> (6,5)</td><td> (6,6)</td><td> (6,7)</td><td> (6,8)</td><td> (6,9)</td></tr><tr><td> (7,0)</td><td> (7,1)</td><td> (7,2)</td><td> (7,3)</td><td> (7,4)</td><td> (7,5)</td><td> (7,6)</td><td> (7,7)</td><td> (7,8)</td><td> (7,9)</td></tr><tr><td> (8,0)</td><td> (8,1)</td><td> (8,2)</td><td> (8,3)</td><td> (8,4)</td><td> (8,5)</td><td> (8,6)</td><td> (8,7)</td><td> (8,8)</td><td> (8,9)</td></tr><tr><td> (9,0)</td><td> (9,1)</td><td> (9,2)</td><td> (9,3)</td><td> (9,4)</td><td> (9,5)</td><td> (9,6)</td><td> (9,7)</td><td> (9,8)</td><td> (9,9)</td></tr></table> - -<h3>Here lies Table 2:</h3> -<table border=1><tr><td>Header Zero</td><td>Header One</td><td>Header Two</td><td>Header Three</td><td>Header Four</td><td>Header Five</td><td>Header Six</td><td>Header Seven</td><td>Header Eight</td><td>Header Nine</td></tr><tr><td> (1,0)</td><td> (1,1)</td><td> (1,2)</td><td> (1,3)</td><td> (1,4)</td><td> (1,5)</td><td> (1,6)</td><td> (1,7)</td><td> (1,8)</td><td> (1,9)</td></tr><tr><td> (2,0)</td><td> (2,1)</td><td> (2,2)</td><td> (2,3)</td><td> (2,4)</td><td> (2,5)</td><td> (2,6)</td><td> (2,7)</td><td> (2,8)</td><td> (2,9)</td></tr><tr><td> (3,0)</td><td> (3,1)</td><td> (3,2)</td><td> (3,3)</td><td> (3,4)</td><td> (3,5)</td><td> (3,6)</td><td> (3,7)</td><td> (3,8)</td><td> (3,9)</td></tr><tr><td> (4,0)</td><td> (4,1)</td><td> (4,2)</td><td> (4,3)</td><td> (4,4)</td><td> (4,5)</td><td> (4,6)</td><td> (4,7)</td><td> (4,8)</td><td> (4,9)</td></tr><tr><td> (5,0)</td><td> (5,1)</td><td> (5,2)</td><td> (5,3)</td><td> (5,4)</td><td> (5,5)</td><td> (5,6)</td><td> (5,7)</td><td> (5,8)</td><td> (5,9)</td></tr><tr><td> (6,0)</td><td> (6,1)</td><td> (6,2)</td><td> (6,3)</td><td> (6,4)</td><td> (6,5)</td><td> (6,6)</td><td> (6,7)</td><td> (6,8)</td><td> (6,9)</td></tr><tr><td> (7,0)</td><td> (7,1)</td><td> (7,2)</td><td> (7,3)</td><td> (7,4)</td><td> (7,5)</td><td> (7,6)</td><td> (7,7)</td><td> (7,8)</td><td> (7,9)</td></tr><tr><td> (8,0)</td><td> (8,1)</td><td> (8,2)</td><td> (8,3)</td><td> (8,4)</td><td> (8,5)</td><td> (8,6)</td><td> (8,7)</td><td> (8,8)</td><td> (8,9)</td></tr><tr><td> (9,0)</td><td> (9,1)</td><td> (9,2)</td><td> (9,3)</td><td> (9,4)</td><td> (9,5)</td><td> (9,6)</td><td> (9,7)</td><td> (9,8)</td><td> (9,9)</td></tr></table> - -<h3>Here lies Table 3 with 4 and 5 inside:</h3> -<table border=1><tr><td>Header Zero</td><td>Header One</td><td>Header Two</td><td>Header Three</td><td>Header Four</td><td>Header Five</td><td>Header Six</td><td>Header Seven</td><td>Header Eight</td><td>Header Nine</td></tr><tr><td> (1,0)</td><td> (1,1)</td><td> (1,2)</td><td> (1,3)</td><td> (1,4)</td><td> (1,5)</td><td> (1,6)</td><td> (1,7)</td><td> (1,8)</td><td> (1,9)</td></tr><tr><td> (2,0)</td><td> (2,1)</td><td> (2,2)</td><td> (2,3)</td><td> (2,4)</td><td> (2,5)</td><td> (2,6)</td><td> (2,7)</td><td> (2,8)</td><td> (2,9)</td></tr><tr><td> (3,0)</td><td> (3,1)</td><td> (3,2)</td><td> (3,3)</td><td> (3,4)</td><td> (3,5)</td><td> (3,6)</td><td> (3,7)</td><td> (3,8)</td><td> (3,9)</td></tr><tr><td> (4,0)</td><td> (4,1)</td><td> (4,2)</td><td> (4,3)</td><td> (4,4)</td><td> (4,5)</td><td> (4,6)</td><td> (4,7)</td><td> (4,8)</td><td> (4,9)</td></tr><tr><td> (5,0)</td><td> (5,1)</td><td> (5,2)</td><td> (5,3)</td><td> (5,4)</td><td> (5,5)<table border=1><tr><td>Header Zero</td><td>Header One</td><td>Header Two</td><td>Header Three</td><td>Header Four</td><td>Header Five</td><td>Header Six</td><td>Header Seven</td><td>Header Eight</td><td>Header Nine</td></tr><tr><td> (1,0)</td><td> (1,1)</td><td> (1,2)</td><td> (1,3)</td><td> (1,4)</td><td> (1,5)</td><td> (1,6)</td><td> (1,7)</td><td> (1,8)</td><td> (1,9)</td></tr><tr><td> (2,0)</td><td> (2,1)</td><td> (2,2)</td><td> (2,3)</td><td> (2,4)</td><td> (2,5)</td><td> (2,6)</td><td> (2,7)</td><td> (2,8)</td><td> (2,9)</td></tr><tr><td> (3,0)</td><td> (3,1)</td><td> (3,2)</td><td> (3,3)</td><td> (3,4)</td><td> (3,5)</td><td> (3,6)</td><td> (3,7)</td><td> (3,8)</td><td> (3,9)</td></tr><tr><td> (4,0)</td><td> (4,1)</td><td> (4,2)</td><td> (4,3)</td><td> (4,4)</td><td> (4,5)</td><td> (4,6)</td><td> (4,7)</td><td> (4,8)</td><td> (4,9)</td></tr><tr><td> (5,0)</td><td> (5,1)</td><td> (5,2)</td><td> (5,3)</td><td> (5,4)</td><td> (5,5)</td><td> (5,6)</td><td> (5,7)</td><td> (5,8)</td><td> (5,9)</td></tr><tr><td> (6,0)</td><td> (6,1)</td><td> (6,2)</td><td> (6,3)</td><td> (6,4)</td><td> (6,5)</td><td> (6,6)</td><td> (6,7)</td><td> (6,8)</td><td> (6,9)</td></tr><tr><td> (7,0)</td><td> (7,1)</td><td> (7,2)</td><td> (7,3)</td><td> (7,4)</td><td> (7,5)</td><td> (7,6)</td><td> (7,7)</td><td> (7,8)</td><td> (7,9)</td></tr><tr><td> (8,0)</td><td> (8,1)</td><td> (8,2)</td><td> (8,3)</td><td> (8,4)</td><td> (8,5)</td><td> (8,6)</td><td> (8,7)</td><td> (8,8)</td><td> (8,9)</td></tr><tr><td> (9,0)</td><td> (9,1)</td><td> (9,2)</td><td> (9,3)</td><td> (9,4)</td><td> (9,5)</td><td> (9,6)</td><td> (9,7)</td><td> (9,8)</td><td> (9,9)</td></tr></table></td><td> (5,6)</td><td> (5,7)</td><td> (5,8)</td><td> (5,9)</td></tr><tr><td> (6,0)</td><td> (6,1)</td><td> (6,2)</td><td> (6,3)</td><td> (6,4)</td><td> (6,5)</td><td> (6,6)</td><td> (6,7)</td><td> (6,8)</td><td> (6,9)</td></tr><tr><td> (7,0)</td><td> (7,1)</td><td> (7,2)</td><td> (7,3)</td><td> (7,4)</td><td> (7,5)</td><td> (7,6)</td><td> (7,7)<table border=1><tr><td>Header Zero</td><td>Header One</td><td>Header Two</td><td>Header Three</td><td>Header Four</td><td>Header Five</td><td>Header Six</td><td>Header Seven</td><td>Header Eight</td><td>Header Nine</td></tr><tr><td> (1,0)</td><td> (1,1)</td><td> (1,2)</td><td> (1,3)</td><td> (1,4)</td><td> (1,5)</td><td> (1,6)</td><td> (1,7)</td><td> (1,8)</td><td> (1,9)</td></tr><tr><td> (2,0)</td><td> (2,1)</td><td> (2,2)</td><td> (2,3)</td><td> (2,4)</td><td> (2,5)</td><td> (2,6)</td><td> (2,7)</td><td> (2,8)</td><td> (2,9)</td></tr><tr><td> (3,0)</td><td> (3,1)</td><td> (3,2)</td><td> (3,3)</td><td> (3,4)</td><td> (3,5)</td><td> (3,6)</td><td> (3,7)</td><td> (3,8)</td><td> (3,9)</td></tr><tr><td> (4,0)</td><td> (4,1)</td><td> (4,2)</td><td> (4,3)</td><td> (4,4)</td><td> (4,5)</td><td> (4,6)</td><td> (4,7)</td><td> (4,8)</td><td> (4,9)</td></tr><tr><td> (5,0)</td><td> (5,1)</td><td> (5,2)</td><td> (5,3)</td><td> (5,4)</td><td> (5,5)</td><td> (5,6)</td><td> (5,7)</td><td> (5,8)</td><td> (5,9)</td></tr><tr><td> (6,0)</td><td> (6,1)</td><td> (6,2)</td><td> (6,3)</td><td> (6,4)</td><td> (6,5)</td><td> (6,6)</td><td> (6,7)</td><td> (6,8)</td><td> (6,9)</td></tr><tr><td> (7,0)</td><td> (7,1)</td><td> (7,2)</td><td> (7,3)</td><td> (7,4)</td><td> (7,5)</td><td> (7,6)</td><td> (7,7)</td><td> (7,8)</td><td> (7,9)</td></tr><tr><td> (8,0)</td><td> (8,1)</td><td> (8,2)</td><td> (8,3)</td><td> (8,4)</td><td> (8,5)</td><td> (8,6)</td><td> (8,7)</td><td> (8,8)</td><td> (8,9)</td></tr><tr><td> (9,0)</td><td> (9,1)</td><td> (9,2)</td><td> (9,3)</td><td> (9,4)</td><td> (9,5)</td><td> (9,6)</td><td> (9,7)</td><td> (9,8)</td><td> (9,9)</td></tr></table></td><td> (7,8)</td><td> (7,9)</td></tr><tr><td> (8,0)</td><td> (8,1)</td><td> (8,2)</td><td> (8,3)</td><td> (8,4)</td><td> (8,5)</td><td> (8,6)</td><td> (8,7)</td><td> (8,8)</td><td> (8,9)</td></tr><tr><td> (9,0)</td><td> (9,1)</td><td> (9,2)</td><td> (9,3)</td><td> (9,4)</td><td> (9,5)</td><td> (9,6)</td><td> (9,7)</td><td> (9,8)</td><td> (9,9)</td></tr></table> - -</body> -</html> -__DOC1 -$docs{basic} = $doc1; - -$doc2 = <<__DOC2; -<html><head><title>skew test</title></head> -<body> -<table border=1> -<tr> - <td>head0</td> - <td>head1</td> - <td>head2</td> - <td>head3</td> -</tr> -<tr> - <td colspan=4>THIS IS A WHOLE ROW-CELL OF JUNK</td> -</tr> -<tr> - <td rowspan=2>JUNK</td> - <td>Tasty tidbit (1,1)</td> - <td>JUNK</td> - <td>Tasty tidbit (1,3)</td> -</tr> -<tr> - <td colspan=2 rowspan=3>BIG JUNK</td> - <td>Tasty tidbit (2,3)</td> -</tr> -<tr> - <td>Tasty tidbit (3,0)</td> - <td>Tasty tidbit (3,3)</td> -</tr> -<tr> - <td>Tasty tidbit (4,0)</td> - <td>Tasty tidbit (4,3)</td> -</tr> -<tr> - <td colspan=2>JUNK BUTTON</td> - <td>Tasty tidbit (5,2)</td> - <td>Tasty tidbit (5,3)</td> -</tr> -</table> -</body> -</html> -__DOC2 -$docs{skew} = $doc2; - -$doc3 = <<__DOC3; -<HTML> -<HEAD><TITLE>Chain Test</TITLE></HEAD> -<BODY> -<H2>You like ugly? I'll show you UGLY:</H2> -<table bgcolor="blue" border=1><tr valign="top"><td valign="top">0,0: (0,0)</td><td valign="top">0,0: (0,1)</td></tr><tr valign="top"><td valign="top">0,0: (1,0)<table bgcolor="green" border=1><tr valign="top"><td valign="top">1,0: (0,0)</td><td valign="top">1,0: (0,1)</td></tr><tr valign="top"><td valign="top">1,0: (1,0)<table bgcolor="cyan" border=1><tr valign="top"><td valign="top">2,0: (0,0)</td><td valign="top">2,0: (0,1)</td></tr><tr valign="top"><td valign="top">2,0: (1,0)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,0: (0,0)</td><td valign="top">3,0: (0,1)</td></tr><tr valign="top"><td valign="top">3,0: (1,0)</td><td valign="top">3,0: (1,1)</td></tr><tr valign="top"><td valign="top">3,0: (2,0)</td><td valign="top">3,0: (2,1)</td></tr></table></td><td valign="top">2,0: (1,1)</td></tr><tr valign="top"><td valign="top">2,0: (2,0)</td><td valign="top">2,0: (2,1)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,1: (0,0)</td><td valign="top">3,1: (0,1)</td></tr><tr valign="top"><td valign="top">3,1: (1,0)</td><td valign="top">3,1: (1,1)</td></tr><tr valign="top"><td valign="top">3,1: (2,0)</td><td valign="top">3,1: (2,1)</td></tr></table></td></tr></table></td><td valign="top">1,0: (1,1)</td></tr><tr valign="top"><td valign="top">1,0: (2,0)</td><td valign="top">1,0: (2,1)<table bgcolor="cyan" border=1><tr valign="top"><td valign="top">2,1: (0,0)</td><td valign="top">2,1: (0,1)</td></tr><tr valign="top"><td valign="top">2,1: (1,0)</td><td valign="top">2,1: (1,1)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,2: (0,0)</td><td valign="top">3,2: (0,1)</td></tr><tr valign="top"><td valign="top">3,2: (1,0)</td><td valign="top">3,2: (1,1)</td></tr><tr valign="top"><td valign="top">3,2: (2,0)</td><td valign="top">3,2: (2,1)</td></tr></table></td></tr><tr valign="top"><td valign="top">2,1: (2,0)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,3: (0,0)</td><td valign="top">3,3: (0,1)</td></tr><tr valign="top"><td valign="top">3,3: (1,0)</td><td valign="top">3,3: (1,1)</td></tr><tr valign="top"><td valign="top">3,3: (2,0)</td><td valign="top">3,3: (2,1)</td></tr></table></td><td valign="top">2,1: (2,1)</td></tr></table></td></tr></table></td><td valign="top">0,0: (1,1)</td></tr><tr valign="top"><td valign="top">0,0: (2,0)</td><td valign="top">0,0: (2,1)<table bgcolor="green" border=1><tr valign="top"><td valign="top">1,1: (0,0)</td><td valign="top">1,1: (0,1)</td></tr><tr valign="top"><td valign="top">1,1: (1,0)</td><td valign="top">1,1: (1,1)<table bgcolor="cyan" border=1><tr valign="top"><td valign="top">2,2: (0,0)</td><td valign="top">2,2: (0,1)</td></tr><tr valign="top"><td valign="top">2,2: (1,0)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,4: (0,0)</td><td valign="top">3,4: (0,1)</td></tr><tr valign="top"><td valign="top">3,4: (1,0)</td><td valign="top">3,4: (1,1)</td></tr><tr valign="top"><td valign="top">3,4: (2,0)</td><td valign="top">3,4: (2,1)</td></tr></table></td><td valign="top">2,2: (1,1)</td></tr><tr valign="top"><td valign="top">2,2: (2,0)</td><td valign="top">2,2: (2,1)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,5: (0,0)</td><td valign="top">3,5: (0,1)</td></tr><tr valign="top"><td valign="top">3,5: (1,0)</td><td valign="top">3,5: (1,1)</td></tr><tr valign="top"><td valign="top">3,5: (2,0)</td><td valign="top">3,5: (2,1)</td></tr></table></td></tr></table></td></tr><tr valign="top"><td valign="top">1,1: (2,0)<table bgcolor="cyan" border=1><tr valign="top"><td valign="top">2,3: (0,0)</td><td valign="top">2,3: (0,1)</td></tr><tr valign="top"><td valign="top">2,3: (1,0)</td><td valign="top">2,3: (1,1)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,6: (0,0)</td><td valign="top">3,6: (0,1)</td></tr><tr valign="top"><td valign="top">3,6: (1,0)</td><td valign="top">3,6: (1,1)</td></tr><tr valign="top"><td valign="top">3,6: (2,0)</td><td valign="top">3,6: (2,1)</td></tr></table></td></tr><tr valign="top"><td valign="top">2,3: (2,0)<table bgcolor="red" border=1><tr valign="top"><td valign="top">3,7: (0,0)</td><td valign="top">3,7: (0,1)</td></tr><tr valign="top"><td valign="top">3,7: (1,0)</td><td valign="top">3,7: (1,1)</td></tr><tr valign="top"><td valign="top">3,7: (2,0)</td><td valign="top">3,7: (2,1)</td></tr></table></td><td valign="top">2,3: (2,1)</td></tr></table></td><td valign="top">1,1: (2,1)</td></tr></table></td></tr></table> -</BODY> -</HTML> -__DOC3 -$docs{chain} = $doc3; - -1; diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/BUILD b/monitoring/PerlModules/CPAN/IO-stringy-1.219/BUILD deleted file mode 100644 index 528b578..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/BUILD +++ /dev/null @@ -1,42 +0,0 @@ -# Macros - -#control upversion -%define external_package 1 - -%define cvs_package PerlModules/CPAN/IO-stringy-1.219 - -# Package specific stuff -Name: perl-IO-stringy -Version: 2.2.0 -Release: 1.1 -Packager: Dave Parker <dparker(a)nocpulse.com> -Summary: Perl persistency primitives -Source: %name-%PACKAGE_VERSION.tar.gz -BuildArch: noarch -Requires: perl -Group: unsorted -License: GPL or Artistic -Vendor: Red Hat, Inc. -Prefix: %{_our_prefix} -BuildRoot: %{_tmppath}/%cvs_package - -%description - -Provides primitives for perl object persistency - -%prep -%entirely_abstract_build_step - -%build -%makefile_build - -%install -cd $RPM_PACKAGE_NAME-$RPM_PACKAGE_VERSION -%makefile_install -%point_scripts_to_correct_perl -%make_file_list - -%files -f %{name}-%{version}-%{release}-filelist - -%clean -%abstract_clean_script diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/MANIFEST b/monitoring/PerlModules/CPAN/IO-stringy-1.219/MANIFEST deleted file mode 100644 index 88f0554..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/MANIFEST +++ /dev/null @@ -1,32 +0,0 @@ -MANIFEST -Makefile.PL -README -README.system -docs/IO/AtomicFile.pm.html -docs/IO/InnerFile.pm.html -docs/IO/Lines.pm.html -docs/IO/Scalar.pm.html -docs/IO/ScalarArray.pm.html -docs/IO/Stringy.pm.html -docs/IO/Wrap.pm.html -docs/IO/WrapTie.pm.html -docs/IO/icons/h1bullet.gif -docs/IO/icons/h2bullet.gif -docs/IO/icons/zeegee.gif -docs/index-menu.html -docs/index.html -docs/index.menu -lib/IO/AtomicFile.pm -lib/IO/InnerFile.pm -lib/IO/Lines.pm -lib/IO/Scalar.pm -lib/IO/ScalarArray.pm -lib/IO/Stringy.pm -lib/IO/Wrap.pm -lib/IO/WrapTie.pm -t/Common.pm -t/ExtUtils/TBone.pm -t/IO_Lines.t -t/IO_Scalar.t -t/IO_ScalarArray.t -t/IO_WrapTie.t diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/Makefile.PL b/monitoring/PerlModules/CPAN/IO-stringy-1.219/Makefile.PL deleted file mode 100755 index aeecddc..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/Makefile.PL +++ /dev/null @@ -1,22 +0,0 @@ -#!/usr/bin/perl -use ExtUtils::MakeMaker; - -#------------------------------------------------------------ -# Makefile: -#------------------------------------------------------------ - -# Ensure the test output directory: -(-d "testout") or mkdir "testout", 0755 or die "please make dir ./testout\n"; - -# Write the Makefile: -WriteMakefile( - NAME => "IO-stringy", - VERSION_FROM => "lib/IO/Stringy.pm", - DISTNAME => "IO-stringy", - 'dist' => { - PREOP => "cvu_perl_preop -m IO::Stringy -f", - COMPRESS => 'gzip', - SUFFIX => 'gz', - } - ); - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/README b/monitoring/PerlModules/CPAN/IO-stringy-1.219/README deleted file mode 100644 index a33220c..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/README +++ /dev/null @@ -1,183 +0,0 @@ -NAME - IO-stringy - I/O on in-core objects like strings and arrays - -SYNOPSIS - IO:: - ::AtomicFile adpO Write a file which is updated atomically ERYQ - ::Lines bdpO I/O handle to read/write to array of lines ERYQ - ::Scalar RdpO I/O handle to read/write to a string ERYQ - ::ScalarArray RdpO I/O handle to read/write to array of scalars ERYQ - ::Wrap RdpO Wrap old-style FHs in standard OO interface ERYQ - ::WrapTie adpO Tie your handles & retain full OO interface ERYQ - -DESCRIPTION - This toolkit primarily provides modules for performing both traditional and object- - oriented i/o) on things *other* than normal filehandles; in particular, IO::Scalar, - IO::ScalarArray, and IO::Lines. - - If you have access to tie(), these classes will make use of the IO::WrapTie module - to inherit a convenient new_tie() constructor. It also exports a nice wraptie() - function. - - In the more-traditional IO::Handle front, we have IO::AtomicFile which may be used - to painlessly create files which are updated atomically. - - And in the "this-may-prove-useful" corner, we have IO::Wrap, whose exported - wraphandle() function will clothe anything that's not a blessed object in an - IO::Handle-like wrapper... so you can just use OO syntax and stop worrying about - whether your function's caller handed you a string, a globref, or a FileHandle. - -INSTALLATION - Most of you already know the drill... - - perl Makefile.PL - make test - make install - - For everyone else out there... if you've never installed Perl code before, or - you're trying to use this in an environment where your sysadmin or ISP won't let - you do interesting things, relax: since this module contains no binary extensions, - you can cheat. That means copying the directory tree under my "./lib" directory - into someplace where your script can "see" it. For example, under Linux: - - cp -r IO-stringy-1.234/lib/* /path/to/my/perl/ - - Now, in your Perl code, do this: - - use lib "/path/to/my/perl"; - use IO::Scalar; ### or whatever - - Ok, now you've been told. At this point, anyone who whines about not being given - enough information gets an unflattering haiku written about them in the next change - log. I'll do it. Don't think I won't. - -VERSION - $Id: README,v 1.1.1.1 2001-03-30 02:46:26 dparker Exp $ - -TO DO - (2000/08/02) Finalize $/ support - Graham Barr submitted this patch half a *year* ago; Like a moron, I lost his - message under a ton of others, and only now have the experimental - implementation done. - - Will the sudden sensitivity to $/ hose anyone out there? I'm worried, so you - have to enable it explicitly. - - (2000/09/28) Separate read/write cursors? - Binkley sent me a very interesting variant of IO::Scalar which maintains two - separate cursors on the data, one for reading and one for writing. Quoth he: - - Isn't it the case that real operating system file descriptors - maintain an independent read and write file position (and - seek(2) resets them both)? - - He also pointed out some issues with his implementation: - - For example, what does eof or tell return? The read position or - the write position? (I assumed read position was more important). - - Your opinions on this are most welcome. (Me, I'm just squeamish that this will - break some code which depends on the existing behavior, and that attempts to - maintain backwards-compatibility will slow down the code. But I'll give it a - shot.) - -CHANGE LOG - Version 1.219 (2001/02/23) - IO::Scalar objects can now be made sensitive to $/ . Pains were taken to keep - the fast code fast while adding this feature. *Cheers to Graham Barr for - submitting his patch; jeers to me for losing his email for 6 months.* - - Version 1.218 (2001/02/23) - IO::Scalar has a new sysseek() method. *Thanks again to Richard Jones.* - - New "TO DO" section, because people who submit patches/ideas should at least - know that they're in the system... and that I won't lose their stuff. Please - read it. - - New entries in the section on "AUTHOR". Please read those too. - - Version 1.216 (2000/09/28) - IO::Scalar and IO::ScalarArray now inherit from IO::Handle. I thought I'd - remembered a problem with this ages ago, related to the fact that these IO:: - modules don't have "real" filehandles, but the problem apparently isn't - surfacing now. If you suddenly encounter Perl warnings during global - destruction (especially if you're using tied filehandles), then please let me - know! *Thanks to B. K. Oxley (binkley) for this.* - - Nasty bug fixed in IO::Scalar::write(). Apparently, the offset and the number- - of-bytes arguments were, for all practical purposes, *reversed.* You were okay - if you did all your writing with print(), but boy was *this* a stupid bug! - *Thanks to Richard Jones for finding this one. For you, Rich, a double-length - haiku:* - - Newspaper headline - typeset by dyslexic man - loses urgency - - BABY EATS FISH is - simply not equivalent - to FISH EATS BABY - - New sysread and syswrite methods for IO::Scalar. *Thanks again to Richard Jones - for this.* - - Version 1.215 (2000/09/05) - Added 'bool' overload to '""' overload, so object always evaluates to true. - (Whew. Glad I caught this before it went to CPAN.) - - Version 1.214 (2000/09/03) - Evaluating an IO::Scalar in a string context now yields the underlying string. - *Thanks to B. K. Oxley (binkley) for this.* - - Version 1.213 (2000/08/16) - Minor documentation fixes. - - Version 1.212 (2000/06/02) - Fixed IO::InnerFile incompatibility with Perl5.004. *Thanks to many folks for - reporting this.* - - Version 1.210 (2000/04/17) - Added flush() and other no-op methods. *Thanks to Doru Petrescu for suggesting - this.* - - Version 1.209 (2000/03/17) - Small bug fixes. - - Version 1.208 (2000/03/14) - Incorporated a number of contributed patches and extensions, mostly related to - speed hacks, support for "offset", and WRITE/CLOSE methods. *Thanks to Richard - Jones, Doru Petrescu, and many others.* - - Version 1.206 (1999/04/18) - Added creation of ./testout when Makefile.PL is run. - - Version 1.205 (1999/01/15) - Verified for Perl5.005. - - Version 1.202 (1998/04/18) - New IO::WrapTie and IO::AtomicFile added. - - Version 1.110 - Added IO::WrapTie. - - Version 1.107 - Added IO::Lines, and made some bug fixes to IO::ScalarArray. Also, added - getc(). - - Version 1.105 - No real changes; just upgraded IO::Wrap to have a $VERSION string. - -AUTHOR - Primary Maintainer - Eryq (eryq(a)zeegee.com) President, ZeeGee Software Inc (http://www.zeegee.com) - - Unofficial Co-Authors - For all their bug reports and patch submissions, the following are officially - recognized: - - Richard Jones - B. K. Oxley (binkley) - Doru Petrescu - - Enjoy. Yell if it breaks. - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/README.system b/monitoring/PerlModules/CPAN/IO-stringy-1.219/README.system deleted file mode 100644 index 64dcd08..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/README.system +++ /dev/null @@ -1,8 +0,0 @@ -DEVELOPMENT SYSTEM: -Linux eryq 2.0.34 #1 Fri May 8 16:05:57 EDT 1998 i586 unknown - -DEVELOPMENT PERL: -This is perl, version 5.005_56 built for i586-linux - -DEVELOPMENT DATE: -Fri Feb 23 04:47:17 EST 2001 diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/AtomicFile.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/AtomicFile.pm.html deleted file mode 100644 index acab65b..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/AtomicFile.pm.html +++ /dev/null @@ -1,101 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::AtomicFile</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::AtomicFile</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -<LI> <A HREF="#REVISION">REVISION</A> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::AtomicFile - write a file which is updated atomically - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - -<PRE> - use IO::AtomicFile; - - # Write a temp file, and have it install itself when closed: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->close || die "couldn't install atomic file: $!"; - - # Write a temp file, but delete it before it gets installed: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->delete; - - # Write a temp file, but neither install it nor delete it: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->detach; -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -This module is intended for people who need to update files -reliably in the face of unexpected program termination. - - -For example, you generally don't want to be halfway in the middle of -writing /etc/passwd and have your program terminate! Even -the act of writing a single scalar to a filehandle is not atomic. - - -But this module gives you true atomic updates, via rename(). -When you open a file /foo/bar.dat via this module, you are actually -opening a temporary file /foo/bar.dat..TMP, and writing your -output there. The act of closing this file (either explicitly -via close(), or implicitly via the destruction of the object) -will cause rename() to be called... therefore, from the point -of view of the outside world, the file's contents are updated -in a single time quantum. - - -To ensure that problems do not go undetected, the "close" method -done by the destructor will raise a fatal exception if the rename() -fails. The explicit close() just returns undef. - - -You can also decide at any point to trash the file you've been -building. - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - - - -<HR> -<A NAME="REVISION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> REVISION</H2></A> - - -$Revision$ - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:46:50 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/InnerFile.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/InnerFile.pm.html deleted file mode 100644 index a090d9d..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/InnerFile.pm.html +++ /dev/null @@ -1,126 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::InnerFile</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::InnerFile</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#PUBLIC_INTERFACE">PUBLIC INTERFACE</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::InnerFile - define a file inside another file - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - -<PRE> - ### Read a subset of a file: - $inner = IO::InnerFile->new($fh, $start, $length); - while (<$inner>) { - ... - } -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -If you have a filehandle that can seek() and tell(), then you -can open an IO::InnerFile on a range of the underlying file. - - - -<HR> -<A NAME="PUBLIC_INTERFACE"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> PUBLIC INTERFACE</H2></A> - - - -<DL> -<DT><A NAME="item:new">new FILEHANDLE, [START, [LENGTH]]</A></DT> -<DD> -Class method, constructor. -Create a new inner-file opened on the given FILEHANDLE, -from bytes START to START+LENGTH. Both START and LENGTH -default to 0; negative values are silently coerced to zero. - - -Note that FILEHANDLE must be able to seek() and tell(), in addition -to whatever other methods you may desire for reading it. - -<DT><A NAME="item:set_length">set_length LENGTH</A></DT> -<DD> -<DT><A NAME="item:get_length">get_length</A></DT> -<DD> -<DT><A NAME="item:add_length">add_length NBYTES</A></DT> -<DD> -Instance methods. -Get/set the virtual length of the inner file. - -<DT><A NAME="item:set_start">set_start START</A></DT> -<DD> -<DT><A NAME="item:get_start">get_start</A></DT> -<DD> -<DT><A NAME="item:add_start">add_start NBYTES</A></DT> -<DD> -Instance methods. -Get/set the virtual start position of the inner file. - -<DT><A NAME="item:binmode">binmode</A></DT> -<DD> -<DT><A NAME="item:close">close</A></DT> -<DD> -<DT><A NAME="item:flush">flush</A></DT> -<DD> -<DT><A NAME="item:getc">getc</A></DT> -<DD> -<DT><A NAME="item:getline">getline</A></DT> -<DD> -<DT><A NAME="item:print">print LIST</A></DT> -<DD> -<DT><A NAME="item:printf">printf LIST</A></DT> -<DD> -<DT><A NAME="item:read">read BUF, NBYTES</A></DT> -<DD> -<DT><A NAME="item:readline">readline</A></DT> -<DD> -<DT><A NAME="item:seek">seek OFFFSET, WHENCE</A></DT> -<DD> -<DT><A NAME="item:tell">tell</A></DT> -<DD> -<DT><A NAME="item:write">write ARGS...</A></DT> -<DD> -Instance methods. -Standard filehandle methods. - -</DL> - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - -Original version by Doru Petrescu (pdoru(a)kappa.ro) - - -Documentation and current maintenance by Eryq (eryq(a)zeegee.com) - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:46:54 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Lines.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Lines.pm.html deleted file mode 100644 index 1f2fef7..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Lines.pm.html +++ /dev/null @@ -1,103 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::Lines</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::Lines</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#VERSION">VERSION</A> -<LI> <A HREF="#AUTHORS">AUTHORS</A> -<UL> -<LI> <A HREF="#Principal_author">Principal author</A> -<LI> <A HREF="#Other_contributors">Other contributors</A> -</UL> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::Lines - IO:: interface for reading/writing an array of lines - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - -<PRE> - use IO::Lines; - - # See IO::ScalarArray for details -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) an array of lines. They can be tiehandle'd as well. - - -This is a subclass of <A HREF="../IO/ScalarArray.pm.html">IO::ScalarArray</A> -in which the underlying -array has its data stored in a line-oriented-format: that is, -every element ends in a <CODE>"\n"</CODE>, with the possible exception of the -final element. This makes <CODE>getline()</CODE> much more efficient; -if you plan to do line-oriented reading/printing, you want this class. - - -The <CODE>print()</CODE> method will enforce this rule, so you can print -arbitrary data to the line-array: it will break the data at -newlines appropriately. - - -See <A HREF="../IO/ScalarArray.pm.html">IO::ScalarArray</A> for full usage. - - - -<HR> -<A NAME="VERSION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> VERSION</H2></A> - - -$Id$ - - - -<HR> -<A NAME="AUTHORS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHORS</H2></A> - - - -<HR> -<A NAME="Principal_author"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Principal author</H3></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - - - -<HR> -<A NAME="Other_contributors"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Other contributors</H3></A> - - -Thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - - -Morris M. Siegel, -for his $/ patch and the new <CODE>getlines()</CODE>. - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:46:56 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Scalar.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Scalar.pm.html deleted file mode 100644 index 62dc174..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Scalar.pm.html +++ /dev/null @@ -1,387 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::Scalar</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::Scalar</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#PUBLIC_INTERFACE">PUBLIC INTERFACE</A> -<UL> -<LI> <A HREF="#Construction">Construction</A> -<LI> <A HREF="#Input_and_output">Input and output</A> -<LI> <A HREF="#Seeking_telling_and_other_attributes">Seeking/telling and other attributes</A> -</UL> -<LI> <A HREF="#VERSION">VERSION</A> -<LI> <A HREF="#AUTHORS">AUTHORS</A> -<UL> -<LI> <A HREF="#Principal_author">Principal author</A> -<LI> <A HREF="#Other_contributors">Other contributors</A> -</UL> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::Scalar - IO:: interface for reading/writing a scalar - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - - -If you have any Perl5, you can use the basic OO interface... - -<PRE> - use IO::Scalar; - - ### Open a handle on a string: - $SH = new IO::Scalar; - $SH->open(\$somestring); - - ### Open a handle on a string, read it line-by-line, then close it: - $SH = new IO::Scalar \$somestring; - while ($_ = $SH->getline) { print "Line: $_" } - $SH->close; - - ### Open a handle on a string, and slurp in all the lines: - $SH = new IO::Scalar \$somestring; - print $SH->getlines; - - ### Open a handle on a string, and append to it: - $SH = new IO::Scalar \$somestring - $SH->print("bar\n"); ### will add "bar\n" to the end - - ### Get the current position: - $pos = $SH->getpos; ### $SH->tell() also works - - ### Set the current position: - $SH->setpos($pos); ### $SH->seek(POS,WHENCE) also works - - ### Open an anonymous temporary scalar: - $SH = new IO::Scalar; - $SH->print("Hi there!"); - print "I got: ", ${$SH->sref}, "\n"; ### get at value -</PRE> - -If your Perl is 5.004 or later, you can use the TIEHANDLE -interface, and read/write scalars just like files: - -<PRE> - use IO::Scalar; -</PRE> -<PRE> - ### Writing to a scalar... - my $s; - tie *OUT, 'IO::Scalar', \$s; - print OUT "line 1\nline 2\n", "line 3\n"; - print "s is now... $s\n" - - ### Reading and writing an anonymous scalar... - tie *OUT, 'IO::Scalar'; - print OUT "line 1\nline 2\n", "line 3\n"; - tied(OUT)->seek(0,0); - while (<OUT>) { print "LINE: ", $_ } -</PRE> - -Stringification now works, too! - -<PRE> - my $SH = new IO::Scalar \$somestring; - $SH->print("Hello, "); - $SH->print("world!"); - print "I've got: <$SH>\n"; -</PRE> - -You can also make the objects sensitive to the $/ setting, -just like IO::Handle wants them to be: - -<PRE> - my $SH = new IO::Scalar \$somestring; - $SH->use_RS(1); ### perlvar's short name for $/ - ... - local $/ = ""; ### read paragraph-at-a-time - $nextpar = $SH->getline; -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) scalars. They can be tiehandle'd as well. - - -Basically, this: - -<PRE> - my $s; - $SH = new IO::Scalar \$s; - $SH->print("Hel", "lo, "); # OO style - $SH->print("world!\n"); # ditto -</PRE> - -Or this (if you have 5.004 or later): - -<PRE> - my $s; - $SH = tie *OUT, 'IO::Scalar', \$s; - print OUT "Hel", "lo, "; # non-OO style - print OUT "world!\n"; # ditto -</PRE> - -Or this (if you have 5.004 or later): - -<PRE> - my $s; - $SH = IO::Scalar->new_tie(\$s); - $SH->print("Hel", "lo, "); # OO style... - print $SH "world!\n"; # ...or non-OO style! -</PRE> - -Causes $s to be set to: - -<PRE> - "Hello, world!\n" -</PRE> - - -<HR> -<A NAME="PUBLIC_INTERFACE"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> PUBLIC INTERFACE</H2></A> - - - -<HR> -<A NAME="Construction"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Construction</H3></A> - - - -<DL> -<DT><A NAME="item:new">new [ARGS...]</A></DT> -<DD> -Class method. -Return a new, unattached scalar handle. -If any arguments are given, they're sent to open(). - -<DT><A NAME="item:open">open [SCALARREF]</A></DT> -<DD> -Instance method. -Open the scalar handle on a new scalar, pointed to by SCALARREF. -If no SCALARREF is given, a "private" scalar is created to hold -the file data. - - -Returns the self object on success, undefined on error. - -<DT><A NAME="item:opened">opened</A></DT> -<DD> -Instance method. -Is the scalar handle opened on something? - -<DT><A NAME="item:close">close</A></DT> -<DD> -Instance method. -Disassociate the scalar handle from its underlying scalar. -Done automatically on destroy. - -</DL> - - - -<HR> -<A NAME="Input_and_output"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Input and output</H3></A> - - - -<DL> -<DT><A NAME="item:flush">flush</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:getc">getc</A></DT> -<DD> -Instance method. -Return the next character, or undef if none remain. - -<DT><A NAME="item:getline">getline</A></DT> -<DD> -Instance method. -Return the next line, or undef on end of string. -Can safely be called in an array context. -Currently, lines are delimited by "\n". - -<DT><A NAME="item:getlines">getlines</A></DT> -<DD> -Instance method. -Get all remaining lines. -It will croak() if accidentally called in a scalar context. - -<DT><A NAME="item:print">print ARGS...</A></DT> -<DD> -Instance method. -Print ARGS to the underlying scalar. - - -Warning: Currently, this always causes a "seek to the end of the string"; -this may change in the future. - -<DT><A NAME="item:read">read BUF, NBYTES, [OFFSET]</A></DT> -<DD> -Instance method. -Read some bytes from the scalar. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -<DT><A NAME="item:write">write BUF, NBYTES, [OFFSET]</A></DT> -<DD> -Instance method. -Write some bytes to the scalar. - -<DT><A NAME="item:sysread">sysread BUF, LEN, [OFFSET]</A></DT> -<DD> -Instance method. -Read some bytes from the scalar. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -<DT><A NAME="item:syswrite">syswrite BUF, NBYTES, [OFFSET]</A></DT> -<DD> -Instance method. -Write some bytes to the scalar. - -</DL> - - - -<HR> -<A NAME="Seeking_telling_and_other_attributes"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Seeking/telling and other attributes</H3></A> - - - -<DL> -<DT><A NAME="item:autoflush">autoflush</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:binmode">binmode</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:clearerr">clearerr</A></DT> -<DD> -Instance method. Clear the error and EOF flags. A no-op. - -<DT><A NAME="item:eof">eof</A></DT> -<DD> -Instance method. Are we at end of file? - -<DT><A NAME="item:seek">seek OFFSET, WHENCE</A></DT> -<DD> -Instance method. Seek to a given position in the stream. - -<DT><A NAME="item:sysseek">sysseek OFFSET, WHENCE</A></DT> -<DD> -Instance method. Identical to <CODE>seek OFFSET, WHENCE</CODE>, q.v. - -<DT><A NAME="item:tell">tell</A></DT> -<DD> -Instance method. -Return the current position in the stream, as a numeric offset. - -<DT><A NAME="item:use_RS">use_RS [YESNO]</A></DT> -<DD> -Instance method. -Obey the curent setting of $/, like IO::Handle does? -Default is false. - -<DT><A NAME="item:setpos">setpos POS</A></DT> -<DD> -Instance method. -Set the current position, using the opaque value returned by <CODE>getpos()</CODE>. - -<DT><A NAME="item:getpos">getpos</A></DT> -<DD> -Instance method. -Return the current position in the string, as an opaque object. - -<DT><A NAME="item:sref">sref</A></DT> -<DD> -Instance method. -Return a reference to the underlying scalar. - -</DL> - - - -<HR> -<A NAME="VERSION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> VERSION</H2></A> - - -$Id$ - - - -<HR> -<A NAME="AUTHORS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHORS</H2></A> - - - -<HR> -<A NAME="Principal_author"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Principal author</H3></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - - - -<HR> -<A NAME="Other_contributors"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Other contributors</H3></A> - - -The full set of contributors always includes the folks mentioned -in <A HREF="../IO/Stringy.pm.html#CHANGE_LOG">CHANGE LOG</A>. But just the same, special -thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - - -Andy Glew, -for contributing <CODE>getc()</CODE>. - - -Brandon Browning, -for suggesting <CODE>opened()</CODE>. - - -David Richter, -for finding and fixing the bug in <CODE>PRINTF()</CODE>. - - -Eric L. Brine, -for his offset-using read() and write() implementations. - - -Richard Jones, -for his patches to massively improve the performance of <CODE>getline()</CODE> -and add <CODE>sysread</CODE> and <CODE>syswrite</CODE>. - - -B. K. Oxley (binkley), -for stringification and inheritance improvements, -and sundry good ideas. - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:46:59 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/ScalarArray.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/ScalarArray.pm.html deleted file mode 100644 index 039896e..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/ScalarArray.pm.html +++ /dev/null @@ -1,338 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::ScalarArray</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::ScalarArray</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#PUBLIC_INTERFACE">PUBLIC INTERFACE</A> -<UL> -<LI> <A HREF="#Construction">Construction</A> -<LI> <A HREF="#Input_and_output">Input and output</A> -<LI> <A HREF="#Seeking_telling_and_other_attributes">Seeking/telling and other attributes</A> -</UL> -<LI> <A HREF="#VERSION">VERSION</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -<UL> -<LI> <A HREF="#Principal_author">Principal author</A> -<LI> <A HREF="#Other_contributors">Other contributors</A> -</UL> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::ScalarArray - IO:: interface for reading/writing an array of scalars - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - - -If you have any Perl5, you can use the basic OO interface... - -<PRE> - use IO::ScalarArray; - - # Open a handle on an array-of-scalars: - $AH = new IO::ScalarArray; - $AH->open(\@a); - - # Open a handle on an array-of-scalars, read it line-by-line, - # then close it: - $AH = new IO::ScalarArray \@a; - while ($_ = $AH->getline) { print "Line: $_" } - $AH->close; - - # Open a handle on an array-of-scalars, and slurp in all the lines: - $AH = new IO::ScalarArray \@a; - print $AH->getlines; - - # Open a handle on an array-of-scalars, and append to it: - $AH = new IO::ScalarArray \@a; - $AH->print("bar\n"); - print "some string is now: ", $somestring, "\n"; - - # Get the current position: - $pos = $AH->getpos; ### $AH->tell() also works - - # Set the current position: - $AH->setpos($pos); ### $AH->seek(POS,WHENCE) also works - - # Open an anonymous temporary scalar array: - $AH = new IO::ScalarArray; - $AH->print("Hi there!\nHey there!\n"); - $AH->print("Ho there!\n"); - print "I got: ", @{$AH->aref}, "\n"; ### get at value -</PRE> - -If your Perl is 5.004 or later, you can use the TIEHANDLE -interface, and read/write as array-of-scalars just like files: - -<PRE> - use IO::ScalarArray; -</PRE> -<PRE> - # Writing to a scalar array... - my @a; - tie *OUT, 'IO::ScalarArray', \@a; - print OUT "line 1\nline 2\n", "line 3\n"; - print "s is now... [", join('', @a), "]\n"; - - # Reading and writing an anonymous scalar array... - tie *OUT, 'IO::ScalarArray'; - print OUT "line 1\nline 2\n", "line 3\n"; - tied(OUT)->seek(0,0); - while (<OUT>) { print "LINE: ", $_ } -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) scalars. They can be tiehandle'd as well. - - -For writing large amounts of data with individual print() statements, -this is likely to be more efficient than IO::Scalar. - - -Basically, this: - -<PRE> - my @a; - $AH = new IO::ScalarArray \@a; - $AH->print("Hel", "lo, "); - $AH->print("world!\n"); -</PRE> - -Or this (if you have 5.004 or later): - -<PRE> - my @a; - $AH = tie *OUT, 'IO::ScalarArray', \@a; - print OUT "Hel", "lo, "; - print OUT "world!\n"; -</PRE> - -Causes @a to be set to the following arrayt of 3 strings: - -<PRE> - ( "Hel" , - "lo, " , - "world!\n" ) -</PRE> - -Compare this with IO::Scalar. - - - -<HR> -<A NAME="PUBLIC_INTERFACE"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> PUBLIC INTERFACE</H2></A> - - - -<HR> -<A NAME="Construction"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Construction</H3></A> - - - -<DL> -<DT><A NAME="item:new">new [ARGS...]</A></DT> -<DD> -Class method. -Return a new, unattached array handle. -If any arguments are given, they're sent to open(). - -<DT><A NAME="item:open">open [ARRAYREF]</A></DT> -<DD> -Instance method. -Open the array handle on a new array, pointed to by ARRAYREF. -If no ARRAYREF is given, a "private" array is created to hold -the file data. - - -Returns the self object on success, undefined on error. - -<DT><A NAME="item:opened">opened</A></DT> -<DD> -Instance method. -Is the array handle opened on something? - -<DT><A NAME="item:close">close</A></DT> -<DD> -Instance method. -Disassociate the array handle from its underlying array. -Done automatically on destroy. - -</DL> - - - -<HR> -<A NAME="Input_and_output"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Input and output</H3></A> - - - -<DL> -<DT><A NAME="item:flush">flush</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:getc">getc</A></DT> -<DD> -Instance method. -Return the next character, or undef if none remain. -This does a read(1), which is somewhat costly. - -<DT><A NAME="item:getline">getline</A></DT> -<DD> -Instance method. -Return the next line, or undef on end of data. -Can safely be called in an array context. -Currently, lines are delimited by "\n". - -<DT><A NAME="item:getlines">getlines</A></DT> -<DD> -Instance method. -Get all remaining lines. -It will croak() if accidentally called in a scalar context. - -<DT><A NAME="item:print">print ARGS...</A></DT> -<DD> -Instance method. -Print ARGS to the underlying array. - - -Currently, this always causes a "seek to the end of the array" -and generates a new array entry. This may change in the future. - -<DT><A NAME="item:read">read BUF, NBYTES, [OFFSET];</A></DT> -<DD> -Instance method. -Read some bytes from the array. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -<DT><A NAME="item:write">write BUF, NBYTES, [OFFSET];</A></DT> -<DD> -Instance method. -Write some bytes into the array. - -</DL> - - - -<HR> -<A NAME="Seeking_telling_and_other_attributes"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Seeking/telling and other attributes</H3></A> - - - -<DL> -<DT><A NAME="item:autoflush">autoflush</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:binmode">binmode</A></DT> -<DD> -Instance method. -No-op, provided for OO compatibility. - -<DT><A NAME="item:clearerr">clearerr</A></DT> -<DD> -Instance method. Clear the error and EOF flags. A no-op. - -<DT><A NAME="item:eof">eof</A></DT> -<DD> -Instance method. Are we at end of file? - -<DT><A NAME="item:seek">seek POS,WHENCE</A></DT> -<DD> -Instance method. -Seek to a given position in the stream. -Only a WHENCE of 0 (SEEK_SET) is supported. - -<DT><A NAME="item:tell">tell</A></DT> -<DD> -Instance method. -Return the current position in the stream, as a numeric offset. - -<DT><A NAME="item:setpos">setpos POS</A></DT> -<DD> -Instance method. -Seek to a given position in the array, using the opaque getpos() value. -Don't expect this to be a number. - -<DT><A NAME="item:getpos">getpos</A></DT> -<DD> -Instance method. -Return the current position in the array, as an opaque value. -Don't expect this to be a number. - -<DT><A NAME="item:aref">aref</A></DT> -<DD> -Instance method. -Return a reference to the underlying array. - -</DL> - - - -<HR> -<A NAME="VERSION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> VERSION</H2></A> - - -$Id$ - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - - -<HR> -<A NAME="Principal_author"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Principal author</H3></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - - - -<HR> -<A NAME="Other_contributors"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> Other contributors</H3></A> - - -Thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - - -Andy Glew, -for suggesting <CODE>getc()</CODE>. - - -Brandon Browning, -for suggesting <CODE>opened()</CODE>. - - -Eric L. Brine, -for his offset-using read() and write() implementations. - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:47:01 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Stringy.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Stringy.pm.html deleted file mode 100644 index fb14ddf..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Stringy.pm.html +++ /dev/null @@ -1,315 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO-stringy</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO-stringy</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#INSTALLATION">INSTALLATION</A> -<LI> <A HREF="#VERSION">VERSION</A> -<LI> <A HREF="#TO_DO">TO DO</A> -<LI> <A HREF="#CHANGE_LOG">CHANGE LOG</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO-stringy - I/O on in-core objects like strings and arrays - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - -<PRE> - IO:: - ::AtomicFile adpO Write a file which is updated atomically ERYQ - ::Lines bdpO I/O handle to read/write to array of lines ERYQ - ::Scalar RdpO I/O handle to read/write to a string ERYQ - ::ScalarArray RdpO I/O handle to read/write to array of scalars ERYQ - ::Wrap RdpO Wrap old-style FHs in standard OO interface ERYQ - ::WrapTie adpO Tie your handles & retain full OO interface ERYQ -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -This toolkit primarily provides modules for performing both traditional -and object-oriented i/o) on things other than normal filehandles; -in particular, <A HREF="../IO/Scalar.pm.html">IO::Scalar</A>, <A HREF="../IO/ScalarArray.pm.html">IO::ScalarArray</A>, -and <A HREF="../IO/Lines.pm.html">IO::Lines</A>. - - -If you have access to tie(), these classes will make use of the -<A HREF="../IO/WrapTie.pm.html">IO::WrapTie</A> module to inherit a convenient new_tie() -constructor. It also exports a nice wraptie() function. - - -In the more-traditional IO::Handle front, we -have <A HREF="../IO/AtomicFile.pm.html">IO::AtomicFile</A> -which may be used to painlessly create files which are updated -atomically. - - -And in the "this-may-prove-useful" corner, we have <A HREF="../IO/Wrap.pm.html">IO::Wrap</A>, -whose exported wraphandle() function will clothe anything that's not -a blessed object in an IO::Handle-like wrapper... so you can just -use OO syntax and stop worrying about whether your function's caller -handed you a string, a globref, or a FileHandle. - - - -<HR> -<A NAME="INSTALLATION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> INSTALLATION</H2></A> - - -Most of you already know the drill... - -<PRE> - perl Makefile.PL - make test - make install -</PRE> - -For everyone else out there... -if you've never installed Perl code before, or you're trying to use -this in an environment where your sysadmin or ISP won't let you do -interesting things, relax: since this module contains no binary -extensions, you can cheat. That means copying the directory tree -under my "./lib" directory into someplace where your script can "see" -it. For example, under Linux: - -<PRE> - cp -r IO-stringy-1.234/lib/* /path/to/my/perl/ - -Now, in your Perl code, do this: -</PRE> -<PRE> - use lib "/path/to/my/perl"; - use IO::Scalar; ### or whatever -</PRE> - -Ok, now you've been told. At this point, anyone who whines about -not being given enough information gets an unflattering haiku -written about them in the next change log. I'll do it. -Don't think I won't. - - - -<HR> -<A NAME="VERSION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> VERSION</H2></A> - - -$Id$ - - - -<HR> -<A NAME="TO_DO"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> TO DO</H2></A> - - - -<DL> -<DT><A NAME="item:2000_08_02_Finalize_support">(2000/08/02) Finalize $/ support</A></DT> -<DD> -Graham Barr submitted this patch half a year ago; -Like a moron, I lost his message under a ton of others, -and only now have the experimental implementation done. - - -Will the sudden sensitivity to $/ hose anyone out there? -I'm worried, so you have to enable it explicitly. - -<DT><A NAME="item:2000_09_28_Separate_read_write_cursors">(2000/09/28) Separate read/write cursors?</A></DT> -<DD> -Binkley sent me a very interesting variant of IO::Scalar which -maintains two separate cursors on the data, one for reading -and one for writing. Quoth he: - -<PRE> - Isn't it the case that real operating system file descriptors - maintain an independent read and write file position (and - seek(2) resets them both)? -</PRE> - -He also pointed out some issues with his implementation: - -<PRE> - For example, what does eof or tell return? The read position or - the write position? (I assumed read position was more important). -</PRE> - -Your opinions on this are most welcome. -(Me, I'm just squeamish that this will break some code -which depends on the existing behavior, and that attempts to -maintain backwards-compatibility will slow down the code. -But I'll give it a shot.) - -</DL> - - - -<HR> -<A NAME="CHANGE_LOG"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> CHANGE LOG</H2></A> - - - -<DL> -<DT><A NAME="item:Version">Version 1.219 (2001/02/23)</A></DT> -<DD> -IO::Scalar objects can now be made sensitive to $/ . -Pains were taken to keep the fast code fast while adding this feature. -Cheers to Graham Barr for submitting his patch; -jeers to me for losing his email for 6 months. - -<DT><A NAME="item:Version">Version 1.218 (2001/02/23)</A></DT> -<DD> -IO::Scalar has a new sysseek() method. -Thanks again to Richard Jones. - - -New "TO DO" section, because people who submit patches/ideas should -at least know that they're in the system... and that I won't lose -their stuff. Please read it. - - -New entries in <A HREF="#AUTHOR">AUTHOR</A>. -Please read those too. - -<DT><A NAME="item:Version">Version 1.216 (2000/09/28)</A></DT> -<DD> -IO::Scalar and IO::ScalarArray now inherit from IO::Handle. -I thought I'd remembered a problem with this ages ago, related to -the fact that these IO:: modules don't have "real" filehandles, -but the problem apparently isn't surfacing now. -If you suddenly encounter Perl warnings during global destruction -(especially if you're using tied filehandles), then please let me know! -Thanks to B. K. Oxley (binkley) for this. - - -Nasty bug fixed in IO::Scalar::write(). -Apparently, the offset and the number-of-bytes arguments were, -for all practical purposes, reversed. You were okay if -you did all your writing with print(), but boy was this a stupid bug! -Thanks to Richard Jones for finding this one. -For you, Rich, a double-length haiku: - -<PRE> - Newspaper headline - typeset by dyslexic man - loses urgency - - BABY EATS FISH is - simply not equivalent - to FISH EATS BABY -</PRE> - -New sysread and syswrite methods for IO::Scalar. -Thanks again to Richard Jones for this. - -<DT><A NAME="item:Version">Version 1.215 (2000/09/05)</A></DT> -<DD> -Added 'bool' overload to '""' overload, so object always evaluates -to true. (Whew. Glad I caught this before it went to CPAN.) - -<DT><A NAME="item:Version">Version 1.214 (2000/09/03)</A></DT> -<DD> -Evaluating an IO::Scalar in a string context now yields -the underlying string. -Thanks to B. K. Oxley (binkley) for this. - -<DT><A NAME="item:Version">Version 1.213 (2000/08/16)</A></DT> -<DD> -Minor documentation fixes. - -<DT><A NAME="item:Version">Version 1.212 (2000/06/02)</A></DT> -<DD> -Fixed IO::InnerFile incompatibility with Perl5.004. -Thanks to many folks for reporting this. - -<DT><A NAME="item:Version">Version 1.210 (2000/04/17)</A></DT> -<DD> -Added flush() and other no-op methods. -Thanks to Doru Petrescu for suggesting this. - -<DT><A NAME="item:Version">Version 1.209 (2000/03/17)</A></DT> -<DD> -Small bug fixes. - -<DT><A NAME="item:Version">Version 1.208 (2000/03/14)</A></DT> -<DD> -Incorporated a number of contributed patches and extensions, -mostly related to speed hacks, support for "offset", and -WRITE/CLOSE methods. -Thanks to Richard Jones, Doru Petrescu, and many others. - -<DT><A NAME="item:Version">Version 1.206 (1999/04/18)</A></DT> -<DD> -Added creation of ./testout when Makefile.PL is run. - -<DT><A NAME="item:Version">Version 1.205 (1999/01/15)</A></DT> -<DD> -Verified for Perl5.005. - -<DT><A NAME="item:Version">Version 1.202 (1998/04/18)</A></DT> -<DD> -New IO::WrapTie and IO::AtomicFile added. - -<DT><A NAME="item:Version">Version 1.110</A></DT> -<DD> -Added IO::WrapTie. - -<DT><A NAME="item:Version">Version 1.107</A></DT> -<DD> -Added IO::Lines, and made some bug fixes to IO::ScalarArray. -Also, added getc(). - -<DT><A NAME="item:Version">Version 1.105</A></DT> -<DD> -No real changes; just upgraded IO::Wrap to have a $VERSION string. - -</DL> - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - - -<DL> -<DT><A NAME="item:Primary_Maintainer">Primary Maintainer</A></DT> -<DD> -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - -<DT><A NAME="item:Unofficial_Co-Authors">Unofficial Co-Authors</A></DT> -<DD> -For all their bug reports and patch submissions, the following -are officially recognized: - -<PRE> - Richard Jones - B. K. Oxley (binkley) - Doru Petrescu -</PRE> -</DL> - - -Enjoy. Yell if it breaks. - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:47:04 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Wrap.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Wrap.pm.html deleted file mode 100644 index ff57b42..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/Wrap.pm.html +++ /dev/null @@ -1,169 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::Wrap</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::Wrap</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#NOTES">NOTES</A> -<LI> <A HREF="#WARNINGS">WARNINGS</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::Wrap - wrap raw filehandles in IO::Handle interface - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - -<PRE> - use IO::Wrap; - - # Do stuff with any kind of filehandle (including a bare globref), or - # any kind of blessed object that responds to a print() message. - # - sub do_stuff { - my $fh = shift; - - ### At this point, we have no idea what the user gave us... - ### a globref? a FileHandle? a scalar filehandle name? - - $fh = wraphandle($fh); - - ### At this point, we know we have an IO::Handle-like object! - - $fh->print("Hey there!"); - ... - } - -</PRE> - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -Let's say you want to write some code which does I/O, but you don't -want to force the caller to provide you with a FileHandle or IO::Handle -object. You want them to be able to say: - -<PRE> - do_stuff(\*STDOUT); - do_stuff('STDERR'); - do_stuff($some_FileHandle_object); - do_stuff($some_IO_Handle_object); -</PRE> - -And even: - -<PRE> - do_stuff($any_object_with_a_print_method); -</PRE> - -Sure, one way to do it is to force the caller to use tiehandle(). -But that puts the burden on them. Another way to do it is to -use IO::Wrap, which provides you with the following functions: - - - -<DL> -<DT><A NAME="item:wraphandle">wraphandle SCALAR</A></DT> -<DD> -This function will take a single argument, and "wrap" it based on -what it seems to be... - - - -<UL> -<LI> -A raw scalar filehandle name, like <CODE>"STDOUT"</CODE> or <CODE>"Class::HANDLE"</CODE>. -In this case, the filehandle name is wrapped in an IO::Wrap object, -which is returned. - -<LI> -A raw filehandle glob, like <CODE>\*STDOUT</CODE>. -In this case, the filehandle glob is wrapped in an IO::Wrap object, -which is returned. - -<LI> -A blessed FileHandle object. -In this case, the FileHandle is wrapped in an IO::Wrap object if and only -if your FileHandle class does not support the <CODE>read()</CODE> method. - -<LI> -Any other kind of blessed object, which is assumed to be already -conformant to the IO::Handle interface. -In this case, you just get back that object. - -</UL> - -</DL> - - -If you get back an IO::Wrap object, it will obey a basic subset of -the IO:: interface. That is, the following methods (note: I said -methods, not named operators) should work on the thing you get back: - -<PRE> - close - getline - getlines - print ARGS... - read BUFFER,NBYTES - seek POS,WHENCE - tell -</PRE> - - -<HR> -<A NAME="NOTES"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NOTES</H2></A> - - -Clearly, when wrapping a raw external filehandle (like \*STDOUT), -I didn't want to close the file descriptor when the "wrapper" object is -destroyed... since the user might not appreciate that! Hence, -there's no DESTROY method in this class. - - -When wrapping a FileHandle object, however, I believe that Perl will -invoke the FileHandle::DESTROY when the last reference goes away, -so in that case, the filehandle is closed if the wrapped FileHandle -really was the last reference to it. - - - -<HR> -<A NAME="WARNINGS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> WARNINGS</H2></A> - - -This module does not allow you to wrap filehandle names which are given -as strings that lack the package they were opened in. That is, if a user -opens FOO in package Foo, they must pass it to you either as <CODE>\*FOO</CODE> -or as <CODE>"Foo::FOO"</CODE>. However, <CODE>"STDIN"</CODE> and friends will work just fine. - - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:47:10 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/WrapTie.pm.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/WrapTie.pm.html deleted file mode 100644 index 8101076..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/WrapTie.pm.html +++ /dev/null @@ -1,418 +0,0 @@ -<HTML> -<HEAD> - <TITLE>IO::WrapTie</TITLE> -</HEAD> -<BODY - bgcolor="#FFFFFF" link="#CC3366" vlink="#993366" alink="#FF6666"> -<A HREF="http://www.zeegee.com" TARGET="_top"><IMG SRC="icons/zeegee.gif" ALT="ZeeGee Software" ALIGN="RIGHT" BORDER="0"></A><A NAME="__TOP__"><H1>IO::WrapTie</H1> -</A><UL> -<LI> <A HREF="#NAME">NAME</A> -<LI> <A HREF="#SYNOPSIS">SYNOPSIS</A> -<LI> <A HREF="#DESCRIPTION">DESCRIPTION</A> -<LI> <A HREF="#HOW_IT_ALL_WORKS">HOW IT ALL WORKS</A> -<UL> -<LI> <A HREF="#The_data_structures">The data structures</A> -<LI> <A HREF="#How_wraptie_works">How wraptie() works</A> -<LI> <A HREF="#How_I_O_operators_work_on_the_master">How I/O operators work (on the master)</A> -<LI> <A HREF="#How_methods_work_on_the_master">How methods work (on the master)</A> -</UL> -<LI> <A HREF="#NOTES">NOTES</A> -<LI> <A HREF="#WARNINGS">WARNINGS</A> -<LI> <A HREF="#AUTHOR">AUTHOR</A> -</UL> -</A> - -<HR> -<A NAME="NAME"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NAME</H2></A> - - -IO::WrapTie - wrap tieable objects in IO::Handle interface - - -This is currently Alpha code, released for comments. - Please give me your feedback! - - - -<HR> -<A NAME="SYNOPSIS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> SYNOPSIS</H2></A> - - -First of all, you'll need tie(), so: - -<PRE> - require 5.004; -</PRE> - -Function interface (experimental). -Use this with any existing class... - -<PRE> - use IO::WrapTie; - use FooHandle; # implements TIEHANDLE interface - - # Suppose we want a "FooHandle->new(&FOO_RDWR, 2)". - # We can instead say... - - $FH = wraptie('FooHandle', &FOO_RDWR, 2); - - # Now we can use... - print $FH "Hello, "; # traditional operator syntax... - $FH->print("world!\n"); # ...and OO syntax as well! -</PRE> - -OO interface (preferred). -You can inherit from the IO::WrapTie::Slave mixin to get a -nifty <CODE>new_tie()</CODE> constructor... - -<PRE> - #------------------------------ - package FooHandle; # a class which can TIEHANDLE - - use IO::WrapTie; - @ISA = qw(IO::WrapTie::Slave); # inherit new_tie() - ... - - - #------------------------------ - package main; - - $FH = FooHandle->new_tie(&FOO_RDWR, 2); # $FH is an IO::WrapTie::Master - print $FH "Hello, "; # traditional operator syntax - $FH->print("world!\n"); # OO syntax -</PRE> - -See IO::Scalar as an example. It also shows you how to create classes -which work both with and without 5.004. - - - -<HR> -<A NAME="DESCRIPTION"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> DESCRIPTION</H2></A> - - -Suppose you have a class <CODE>FooHandle</CODE>, where... - - - -<UL> -<LI> -FooHandle does not inherit from IO::Handle; that is, it performs -filehandle-like I/O, but to something other than an underlying -file descriptor. Good examples are IO::Scalar (for printing to a -string) and IO::Lines (for printing to an array of lines). - -<LI> -FooHandle implements the TIEHANDLE interface (see <A HREF="perltie.pm.html">perltie</A>); -that is, it provides methods TIEHANDLE, GETC, PRINT, PRINTF, -READ, and READLINE. - -<LI> -FooHandle implements the traditional OO interface of -FileHandle and IO::Handle; i.e., it contains methods like getline(), -read(), print(), seek(), tell(), eof(), etc. - -</UL> - - -Normally, users of your class would have two options: - - - -<UL> -<LI> -Use only OO syntax, and forsake named I/O operators like 'print'. - -<LI> -Use with tie, and forsake treating it as a first-class object -(i.e., class-specific methods can only be invoked through the underlying -object via tied()... giving the object a "split personality"). - -</UL> - - -But now with IO::WrapTie, you can say: - -<PRE> - $WT = wraptie('FooHandle', &FOO_RDWR, 2); - $WT->print("Hello, world\n"); # OO syntax - print $WT "Yes!\n"; # Named operator syntax too! - $WT->weird_stuff; # Other methods! -</PRE> - -And if you're authoring a class like FooHandle, just have it inherit -from <CODE>IO::WrapTie::Slave</CODE> and that first line becomes even prettier: - -<PRE> - $WT = FooHandle->new_tie(&FOO_RDWR, 2); -</PRE> - -The bottom line: now, almost any class can look and work exactly like -an IO::Handle... and be used both with OO and non-OO filehandle syntax. - - - -<HR> -<A NAME="HOW_IT_ALL_WORKS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> HOW IT ALL WORKS</H2></A> - - - -<HR> -<A NAME="The_data_structures"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> The data structures</H3></A> - - -Consider this example code, using classes in this distribution: - -<PRE> - use IO::Scalar; - use IO::WrapTie; - - $WT = wraptie('IO::Scalar',\$s); - print $WT "Hello, "; - $WT->print("world!\n"); -</PRE> - -In it, the wraptie() function creates a data structure as follows: - -<PRE> - * $WT is a blessed reference to a tied filehandle - $WT glob; that glob is tied to the "Slave" object. - | * You would do all your i/o with $WT directly. - | - | - | ,---isa--> IO::WrapTie::Master >--isa--> IO::Handle - V / - .-------------. - | | - | | * Perl i/o operators work on the tied object, - | "Master" | invoking the TIEHANDLE methods. - | | * Method invocations are delegated to the tied - | | slave. - `-------------' - | - tied(*$WT) | .---isa--> IO::WrapTie::Slave - V / - .-------------. - | | - | "Slave" | * Instance of FileHandle-like class which doesn't - | | actually use file descriptors, like IO::Scalar. - | IO::Scalar | * The slave can be any kind of object. - | | * Must implement the TIEHANDLE interface. - `-------------' -</PRE> - -NOTE: just as an IO::Handle is really just a blessed reference to a -traditional filehandle glob... so also, an IO::WrapTie::Master -is really just a blessed reference to a filehandle -glob which has been tied to some "slave" class. - - - -<HR> -<A NAME="How_wraptie_works"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> How wraptie() works</H3></A> - - - -<OL> -<LI> -The call to function <CODE>wraptie(SLAVECLASS, TIEARGS...)</CODE> is -passed onto <CODE>IO::WrapTie::Master::new()</CODE>. -Note that class IO::WrapTie::Master is a subclass of IO::Handle. - -<LI> -The <CODE>IO::WrapTie::Master::new</CODE> method creates a new IO::Handle object, -reblessed into class IO::WrapTie::Master. This object is the master, -which will be returned from the constructor. At the same time... - -<LI> -The <CODE>new</CODE> method also creates the slave: this is an instance -of SLAVECLASS which is created by tying the master's IO::Handle -to SLAVECLASS via <CODE>tie(HANDLE, SLAVECLASS, TIEARGS...)</CODE>. -This call to <CODE>tie()</CODE> creates the slave in the following manner: - -<LI> -Class SLAVECLASS is sent the message <CODE>TIEHANDLE(TIEARGS...)</CODE>; it -will usually delegate this to <CODE>SLAVECLASS::new(TIEARGS...)</CODE>, resulting -in a new instance of SLAVECLASS being created and returned. - -<LI> -Once both master and slave have been created, the master is returned -to the caller. - -</OL> - - - -<HR> -<A NAME="How_I_O_operators_work_on_the_master"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> How I/O operators work (on the master)</H3></A> - - -Consider using an i/o operator on the master: - -<PRE> - print $WT "Hello, world!\n"; -</PRE> - -Since the master ($WT) is really a [blessed] reference to a glob, -the normal Perl i/o operators like <CODE>print</CODE> may be used on it. -They will just operate on the symbol part of the glob. - - -Since the glob is tied to the slave, the slave's PRINT method -(part of the TIEHANDLE interface) will be automatically invoked. - - -If the slave is an IO::Scalar, that means IO::Scalar::PRINT will be -invoked, and that method happens to delegate to the <CODE>print()</CODE> method -of the same class. So the real work is ultimately done by -IO::Scalar::print(). - - - -<HR> -<A NAME="How_methods_work_on_the_master"><H3><A HREF="#__TOP__"><IMG SRC="icons/h2bullet.gif" ALT="Top" BORDER="0"></A> How methods work (on the master)</H3></A> - - -Consider using a method on the master: - -<PRE> - $WT->print("Hello, world!\n"); -</PRE> - -Since the master ($WT) is blessed into the class IO::WrapTie::Master, -Perl first attempts to find a <CODE>print()</CODE> method there. Failing that, -Perl next attempts to find a <CODE>print()</CODE> method in the superclass, -IO::Handle. It just so happens that there is such a method; -that method merely invokes the <CODE>print</CODE> i/o operator on the self object... -and for that, see above! - - -But let's suppose we're dealing with a method which isn't part -of IO::Handle... for example: - -<PRE> - my $sref = $WT->sref; -</PRE> - -In this case, the intuitive behavior is to have the master delegate the -method invocation to the slave (now do you see where the designations -come from?). This is indeed what happens: IO::WrapTie::Master contains -an AUTOLOAD method which performs the delegation. - - -So: when <CODE>sref()</CODE> can't be found in IO::Handle, the AUTOLOAD method -of IO::WrapTie::Master is invoked, and the standard behavior of -delegating the method to the underlying slave (here, an IO::Scalar) -is done. - - -Sometimes, to get this to work properly, you may need to create -a subclass of IO::WrapTie::Master which is an effective master for -your class, and do the delegation there. - - - -<HR> -<A NAME="NOTES"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> NOTES</H2></A> - - -Why not simply use the object's OO interface? - Because that means forsaking the use of named operators -like print(), and you may need to pass the object to a subroutine -which will attempt to use those operators: - -<PRE> - $O = FooHandle->new(&FOO_RDWR, 2); - $O->print("Hello, world\n"); # OO syntax is okay, BUT.... - - sub nope { print $_[0] "Nope!\n" } - X nope($O); # ERROR!!! (not a glob ref) - -</PRE> - -Why not simply use tie()? - Because (1) you have to use tied() to invoke methods in the -object's public interface (yuck), and (2) you may need to pass -the tied symbol to another subroutine which will attempt to treat -it in an OO-way... and that will break it: - -<PRE> - tie *T, 'FooHandle', &FOO_RDWR, 2; - print T "Hello, world\n"; # Operator is okay, BUT... - - tied(*T)->other_stuff; # yuck! AND... - - sub nope { shift->print("Nope!\n") } - X nope(\*T); # ERROR!!! (method "print" on unblessed ref) -</PRE> - -Why a master and slave? - Why not simply write FooHandle to inherit from IO::Handle? - I tried this, with an implementation similar to that of IO::Socket. -The problem is that the whole point is to use this with objects -that don't have an underlying file/socket descriptor.. -Subclassing IO::Handle will work fine for the OO stuff, and fine with -named operators if you tie()... but if you just attempt to say: - -<PRE> - $IO = FooHandle->new(&FOO_RDWR, 2); - print $IO "Hello!\n"; -</PRE> - -you get a warning from Perl like: - -<PRE> - Filehandle GEN001 never opened -</PRE> - -because it's trying to do system-level i/o on an (unopened) file -descriptor. To avoid this, you apparently have to tie() the handle... -which brings us right back to where we started! At least the -IO::WrapTie mixin lets us say: - -<PRE> - $IO = FooHandle->new_tie(&FOO_RDWR, 2); - print $IO "Hello!\n"; -</PRE> - -and so is not too bad. <CODE>:-)</CODE> - - - -<HR> -<A NAME="WARNINGS"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> WARNINGS</H2></A> - - -Remember: this stuff is for doing FileHandle-like i/o on things -without underlying file descriptors. If you have an underlying -file descriptor, you're better off just inheriting from IO::Handle. - - -Be aware that new_tie() always returns an instance of a -kind of IO::WrapTie::Master... it does not return an instance -of the i/o class you're tying to! - - -Invoking some methods on the master object causes AUTOLOAD to delegate -them to the slave object... so it looks like you're manipulating a -"FooHandle" object directly, but you're not. - - -I have not explored all the ramifications of this use of tie(). -Here there be dragons. - - - -<HR> -<A NAME="AUTHOR"><H2><A HREF="#__TOP__"><IMG SRC="icons/h1bullet.gif" ALT="Top" BORDER="0"></A> AUTHOR</H2></A> - - -Eryq (<FILE><A HREF="mailto:eryq@zeegee.com">eryq(a)zeegee.com</A></FILE>). -President, ZeeGee Software Inc (<FILE><A HREF="http://www.zeegee.com">http://www.zeegee.com</A></FILE>). - -<HR> -<ADDRESS> -Generated Fri Feb 23 04:47:13 2001 by cvu_pod2html -</ADDRESS> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h1bullet.gif b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h1bullet.gif deleted file mode 100644 index 8698643..0000000 Binary files a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h1bullet.gif and /dev/null differ diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h2bullet.gif b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h2bullet.gif deleted file mode 100644 index d26510c..0000000 Binary files a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/h2bullet.gif and /dev/null differ diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/zeegee.gif b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/zeegee.gif deleted file mode 100644 index f6001a5..0000000 Binary files a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/IO/icons/zeegee.gif and /dev/null differ diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index-menu.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index-menu.html deleted file mode 100644 index 890a1f6..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index-menu.html +++ /dev/null @@ -1,31 +0,0 @@ -<HTML> -<HEAD> -<TITLE>perlmod</TITLE> -</HEAD> -<BODY BGCOLOR="#FFFFFF" LINK="#CC3366" ALINK="#FF6666" VLINK="#993366"> -<TABLE> - -<TR VALIGN="TOP"><TH ALIGN="LEFT">Overview</TH> -<TR VALIGN="TOP"><TD><A HREF="IO/Stringy.pm.html" TARGET="perlmod.content">IO::Stringy</A></TD></TR> -</TABLE> -<HR> -<TABLE> - -<TR VALIGN="TOP"><TH ALIGN="LEFT">Modules</TH> -<TR VALIGN="TOP"><TD><A HREF="IO/AtomicFile.pm.html" TARGET="perlmod.content">IO::AtomicFile</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/InnerFile.pm.html" TARGET="perlmod.content">IO::InnerFile</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/Lines.pm.html" TARGET="perlmod.content">IO::Lines</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/Scalar.pm.html" TARGET="perlmod.content">IO::Scalar</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/ScalarArray.pm.html" TARGET="perlmod.content">IO::ScalarArray</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/Wrap.pm.html" TARGET="perlmod.content">IO::Wrap</A></TD></TR> - -<TR VALIGN="TOP"><TD><A HREF="IO/WrapTie.pm.html" TARGET="perlmod.content">IO::WrapTie</A></TD></TR> -</TABLE> -<HR> -</BODY> -</HTML> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.html b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.html deleted file mode 100644 index bac53b8..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.html +++ /dev/null @@ -1,13 +0,0 @@ -<HEAD> -<TITLE>perlmod</TITLE> -</HEAD> -<FRAMESET COLS="20%,*" BORDER=1 FRAMEBORDER=1 FRAMESPACING=10> - <FRAME NAME="perlmod.menu" SRC="index-menu.html"> - <FRAME NAME="perlmod.content" SRC="IO/Stringy.pm.html"> -</FRAMESET> - -<NOFRAMES> - <BODY> - Go <A HREF="menu.html">here</A> - </BODY> -</NOFRAMES> diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.menu b/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.menu deleted file mode 100644 index 92466a8..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/docs/index.menu +++ /dev/null @@ -1,30 +0,0 @@ -MENU perlmod - -SECTION Overview - -ITEM IO::Stringy -HREF IO/Stringy.pm.html - -SECTION Modules - -ITEM IO::AtomicFile -HREF IO/AtomicFile.pm.html - -ITEM IO::InnerFile -HREF IO/InnerFile.pm.html - -ITEM IO::Lines -HREF IO/Lines.pm.html - -ITEM IO::Scalar -HREF IO/Scalar.pm.html - -ITEM IO::ScalarArray -HREF IO/ScalarArray.pm.html - -ITEM IO::Wrap -HREF IO/Wrap.pm.html - -ITEM IO::WrapTie -HREF IO/WrapTie.pm.html - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/AtomicFile.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/AtomicFile.pm deleted file mode 100644 index b535d03..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/AtomicFile.pm +++ /dev/null @@ -1,190 +0,0 @@ -package IO::AtomicFile; - -### DOCUMENTATION AT BOTTOM OF FILE - -# Be strict: -use strict; - -# External modules: -use IO::File; - - -#------------------------------ -# -# GLOBALS... -# -#------------------------------ -use vars qw($VERSION @ISA); - -# The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - -# Inheritance: -@ISA = qw(IO::File); - - -#------------------------------ -# new ARGS... -#------------------------------ -# Class method, constructor. -# Any arguments are sent to open(). -# -sub new { - my $class = shift; - my $self = $class->SUPER::new(); - ${*$self}{'io_atomicfile_suffix'} = ''; - $self->open(@_) if @_; - $self; -} - -#------------------------------ -# DESTROY -#------------------------------ -# Destructor. -# -sub DESTROY { - shift->close(1); # like close, but raises fatal exception on failure -} - -#------------------------------ -# open PATH, MODE -#------------------------------ -# Class/instance method. -# -sub open { - my ($self, $path, $mode) = @_; - ref($self) or $self = $self->new; # now we have an instance! - - # Create tmp path, and remember this info: - my $temp = "${path}..TMP" . ${*$self}{'io_atomicfile_suffix'}; - ${*$self}{'io_atomicfile_temp'} = $temp; - ${*$self}{'io_atomicfile_path'} = $path; - - # Open the file! Returns filehandle on success, for use as a constructor: - $self->SUPER::open($temp, $mode) ? $self : undef; -} - -#------------------------------ -# _closed [YESNO] -#------------------------------ -# Instance method, private. -# Are we already closed? Argument sets new value, returns previous one. -# -sub _closed { - my $self = shift; - my $oldval = ${*$self}{'io_atomicfile_closed'}; - ${*$self}{'io_atomicfile_closed'} = shift if @_; - $oldval; -} - -#------------------------------ -# close -#------------------------------ -# Instance method. -# Close the handle, and rename the temp file to its final name. -# -sub close { - my ($self, $die) = @_; - unless ($self->_closed(1)) { # sentinel... - $self->SUPER::close(); - rename(${*$self}{'io_atomicfile_temp'}, - ${*$self}{'io_atomicfile_path'}) - or ($die ? die "close atomic file: $!\n" : return undef); - } - 1; -} - -#------------------------------ -# delete -#------------------------------ -# Instance method. -# Close the handle, and delete the temp file. -# -sub delete { - my $self = shift; - unless ($self->_closed(1)) { # sentinel... - $self->SUPER::close(); - return unlink(${*$self}{'io_atomicfile_temp'}); - } - 1; -} - -#------------------------------ -# detach -#------------------------------ -# Instance method. -# Close the handle, but DO NOT delete the temp file. -# -sub detach { - my $self = shift; - $self->SUPER::close() unless ($self->_closed(1)); - 1; -} - -#------------------------------ -1; -__END__ - - -=head1 NAME - -IO::AtomicFile - write a file which is updated atomically - - -=head1 SYNOPSIS - - use IO::AtomicFile; - - # Write a temp file, and have it install itself when closed: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->close || die "couldn't install atomic file: $!"; - - # Write a temp file, but delete it before it gets installed: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->delete; - - # Write a temp file, but neither install it nor delete it: - my $FH = IO::AtomicFile->open("bar.dat", "w"); - print $FH "Hello!\n"; - $FH->detach; - - -=head1 DESCRIPTION - -This module is intended for people who need to update files -reliably in the face of unexpected program termination. - -For example, you generally don't want to be halfway in the middle of -writing I</etc/passwd> and have your program terminate! Even -the act of writing a single scalar to a filehandle is I<not> atomic. - -But this module gives you true atomic updates, via rename(). -When you open a file I</foo/bar.dat> via this module, you are I<actually> -opening a temporary file I</foo/bar.dat..TMP>, and writing your -output there. The act of closing this file (either explicitly -via close(), or implicitly via the destruction of the object) -will cause rename() to be called... therefore, from the point -of view of the outside world, the file's contents are updated -in a single time quantum. - -To ensure that problems do not go undetected, the "close" method -done by the destructor will raise a fatal exception if the rename() -fails. The explicit close() just returns undef. - -You can also decide at any point to trash the file you've been -building. - - -=head1 AUTHOR - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - - -=head1 REVISION - -$Revision: 1.999 $ - -=cut diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/InnerFile.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/InnerFile.pm deleted file mode 100644 index db7cd32..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/InnerFile.pm +++ /dev/null @@ -1,274 +0,0 @@ -package IO::InnerFile; - -=head1 NAME - -IO::InnerFile - define a file inside another file - - -=head1 SYNOPSIS - - - ### Read a subset of a file: - $inner = IO::InnerFile->new($fh, $start, $length); - while (<$inner>) { - ... - } - - -=head1 DESCRIPTION - -If you have a filehandle that can seek() and tell(), then you -can open an IO::InnerFile on a range of the underlying file. - - -=head1 PUBLIC INTERFACE - -=over - -=cut - -use Symbol; - -# The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - -#------------------------------ - -=item new FILEHANDLE, [START, [LENGTH]] - -I<Class method, constructor.> -Create a new inner-file opened on the given FILEHANDLE, -from bytes START to START+LENGTH. Both START and LENGTH -default to 0; negative values are silently coerced to zero. - -Note that FILEHANDLE must be able to seek() and tell(), in addition -to whatever other methods you may desire for reading it. - -=cut - -sub new { - my ($class, $fh, $start, $lg) = @_; - $start = 0 if (!$start or ($start < 0)); - $lg = 0 if (!$lg or ($lg < 0)); - - ### Create the underlying "object": - my $a = { - FH => $fh, - CRPOS => 0, - START => $start, - LG => $lg, - }; - - ### Create a new filehandle tied to this object: - $fh = gensym; - tie(*$fh, $class, $a); - return bless($fh, $class); -} - -sub TIEHANDLE { - my ($class, $data) = @_; - return bless($data, $class); -} - -sub DESTROY { - my ($self) = @_; - $self->close() if (ref($self) eq 'SCALAR'); -} - -#------------------------------ - -=item set_length LENGTH - -=item get_length - -=item add_length NBYTES - -I<Instance methods.> -Get/set the virtual length of the inner file. - -=cut - -sub set_length { tied(${$_[0]})->{LG} = $_[1]; } -sub get_length { tied(${$_[0]})->{LG}; } -sub add_length { tied(${$_[0]})->{LG} += $_[1]; } - -#------------------------------ - -=item set_start START - -=item get_start - -=item add_start NBYTES - -I<Instance methods.> -Get/set the virtual start position of the inner file. - -=cut - -sub set_start { tied(${$_[0]})->{START} = $_[1]; } -sub get_start { tied(${$_[0]})->{START}; } -sub set_end { tied(${$_[0]})->{LG} = $_[1] - tied(${$_[0]})->{START}; } -sub get_end { tied(${$_[0]})->{LG} + tied(${$_[0]})->{START}; } - - -#------------------------------ - -=item binmode - -=item close - -=item flush - -=item getc - -=item getline - -=item print LIST - -=item printf LIST - -=item read BUF, NBYTES - -=item readline - -=item seek OFFFSET, WHENCE - -=item tell - -=item write ARGS... - -I<Instance methods.> -Standard filehandle methods. - -=cut - -sub write { shift->WRITE(@_) } -sub print { shift->PRINT(@_) } -sub printf { shift->PRINTF(@_) } -sub flush { 1; } -sub binmode { 1; } -sub getc { return GETC(tied(${$_[0]}) ); } -sub read { return READ( tied(${$_[0]}), @_[1,2,3] ); } -sub readline { return READLINE( tied(${$_[0]}) ); } -sub getline { return READLINE( tied(${$_[0]}) ); } -sub close { return CLOSE(tied(${$_[0]}) ); } - -sub seek { - my ($self, $ofs, $whence) = @_; - $self = tied( $$self ); - - $self->{CRPOS} = $ofs if ($whence == 0); - $self->{CRPOS}+= $ofs if ($whence == 1); - $self->{CRPOS} = $self->{LG} + $ofs if ($whence == 2); - - $self->{CRPOS} = 0 if ($self->{CRPOS} < 0); - $self->{CRPOS} = $self->{LG} if ($self->{CRPOS} > $self->{LG}); -} - -sub tell { - return tied(${$_[0]})->{CRPOS}; -} - -sub WRITE { - die "inner files can only open for reading\n"; -} - -sub PRINT { - die "inner files can only open for reading\n"; -} - -sub PRINTF { - die "inner files can only open for reading\n"; -} - -sub GETC { - my ($self) = @_; - return 0 if ($self->{CRPOS} >= $self->{LG}); - - my $data; - - ### Save and seek... - my $old_pos = $self->{FH}->tell; - $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); - - ### ...read... - my $lg = $self->{FH}->read($data, 1); - $self->{CRPOS} += $lg; - - ### ...and restore: - $self->{FH}->seek($old_pos, 0); - - $self->{LG} = $self->{CRPOS} unless ($lg); - return ($lg ? $data : undef); -} - -sub READ { - my ($self, $undefined, $lg, $ofs) = @_; - $undefined = undef; - - return 0 if ($self->{CRPOS} >= $self->{LG}); - $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); - return 0 unless ($lg); - - ### Save and seek... - my $old_pos = $self->{FH}->tell; - $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); - - ### ...read... - $lg = $self->{FH}->read($_[1], $lg, $_[3] ); - $self->{CRPOS} += $lg; - - ### ...and restore: - $self->{FH}->seek($old_pos, 0); - - $self->{LG} = $self->{CRPOS} unless ($lg); - return $lg; -} - -sub READLINE { - my ($self) = @_; - return undef if ($self->{CRPOS} >= $self->{LG}); - - ### Save and seek... - my $old_pos = $self->{FH}->tell; - $self->{FH}->seek($self->{CRPOS}+$self->{START}, 0); - - ### ...read... - my $text = $self->{FH}->getline; - - ### ...and restore: - $self->{FH}->seek($old_pos, 0); - - #### If we detected a new EOF ... - unless (defined $text) { - $self->{LG} = $self->{CRPOS}; - return undef; - } - - my $lg=length($text); - - $lg = $self->{LG} - $self->{CRPOS} if ($self->{CRPOS} + $lg > $self->{LG}); - $self->{CRPOS} += $lg; - - return substr($text, 0,$lg); -} - -sub CLOSE { %{$_[0]}=(); } - - - -1; -__END__ - -=back - - -=head1 AUTHOR - -Original version by Doru Petrescu (pdoru(a)kappa.ro) - -Documentation and current maintenance by Eryq (eryq(a)zeegee.com) - -=cut - - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Lines.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Lines.pm deleted file mode 100644 index f2f2f91..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Lines.pm +++ /dev/null @@ -1,148 +0,0 @@ -package IO::Lines; - - -=head1 NAME - -IO::Lines - IO:: interface for reading/writing an array of lines - - -=head1 SYNOPSIS - - use IO::Lines; - - # See IO::ScalarArray for details - - -=head1 DESCRIPTION - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) an array of lines. They can be tiehandle'd as well. - -This is a subclass of L<IO::ScalarArray|IO::ScalarArray> -in which the underlying -array has its data stored in a line-oriented-format: that is, -every element ends in a C<"\n">, with the possible exception of the -final element. This makes C<getline()> I<much> more efficient; -if you plan to do line-oriented reading/printing, you want this class. - -The C<print()> method will enforce this rule, so you can print -arbitrary data to the line-array: it will break the data at -newlines appropriately. - -See L<IO::ScalarArray> for full usage. - -=cut - -use Carp; -use strict; -use IO::ScalarArray; -use vars qw($VERSION @ISA); - -# The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - -# Inheritance: -@ISA = qw(IO::ScalarArray); # also gets us new_tie :-) - - -#------------------------------ -# getline -#------------------------------ -# Instance method, override. -# Return the next line, or undef on end of data. -# Can safely be called in an array context. -# Currently, lines are delimited by "\n". -# -sub getline { - my $self = shift; - if (!defined $/) { - return join( '' => $self->getlines ); - } - ($/ eq "\n") - or croak '$/ must be "\n" or undef, not ', "'$/'."; - - if (!$self->{Pos}) { # full line... - return $self->{AR}[$self->{Str}++]; - } - else { # partial line... - my $partial = substr($self->{AR}[$self->{Str}++], $self->{Pos}); - $self->{Pos} = 0; - return $partial; - } -} - -#------------------------------ -# getlines -#------------------------------ -# Instance method, override. -# Return an array comprised of the remaining lines, or () on end of data. -# Must be called in an array context. -# Currently, lines are delimited by "\n". -# -sub getlines { - my $self = shift; - wantarray or croak("Can't call getlines in scalar context!"); - - my ($rArray, $Str, $Pos) = @$self{ qw( AR Str Pos ) }; - my @partial = (); - - if ($Pos) { # partial line... - @partial = (substr( $rArray->[ $Str++ ], $Pos )); - $self->{Pos} = 0; - } - $self->{Str} = scalar @$rArray; # about to exhaust @$rArray - return (@partial, - @$rArray[ $Str .. $#$rArray ]); # remaining full lines... -} - -#------------------------------ -# print ARGS... -#------------------------------ -# Instance method, override. -# Print ARGS to the underlying line array. -# -sub print { - my $self = shift; - ### print STDERR "\n[[ARRAY WAS...\n", @{$self->{AR}}, "<<EOF>>\n"; - my @lines = split /^/, join('', @_); @lines or return 1; - - # Did the previous print not end with a newline? If so, append first line: - if (@{$self->{AR}} and ($self->{AR}[-1] !~ /\n\Z/)) { - $self->{AR}[-1] .= shift @lines; - } - push @{$self->{AR}}, @lines; # add the remainder - ### print STDERR "\n[[ARRAY IS NOW...\n", @{$self->{AR}}, "<<EOF>>\n"; - 1; -} - -#------------------------------ -1; - -__END__ - - -=head1 VERSION - -$Id: Lines.pm,v 1.999 2001-03-30 03:13:03 dparker Exp $ - - -=head1 AUTHORS - - -=head2 Principal author - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - - -=head2 Other contributors - -Thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - -I<Morris M. Siegel,> -for his $/ patch and the new C<getlines()>. - -=cut - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Scalar.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Scalar.pm deleted file mode 100644 index ab33199..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Scalar.pm +++ /dev/null @@ -1,674 +0,0 @@ -package IO::Scalar; - - -=head1 NAME - -IO::Scalar - IO:: interface for reading/writing a scalar - - -=head1 SYNOPSIS - -If you have any Perl5, you can use the basic OO interface... - - use IO::Scalar; - - ### Open a handle on a string: - $SH = new IO::Scalar; - $SH->open(\$somestring); - - ### Open a handle on a string, read it line-by-line, then close it: - $SH = new IO::Scalar \$somestring; - while ($_ = $SH->getline) { print "Line: $_" } - $SH->close; - - ### Open a handle on a string, and slurp in all the lines: - $SH = new IO::Scalar \$somestring; - print $SH->getlines; - - ### Open a handle on a string, and append to it: - $SH = new IO::Scalar \$somestring - $SH->print("bar\n"); ### will add "bar\n" to the end - - ### Get the current position: - $pos = $SH->getpos; ### $SH->tell() also works - - ### Set the current position: - $SH->setpos($pos); ### $SH->seek(POS,WHENCE) also works - - ### Open an anonymous temporary scalar: - $SH = new IO::Scalar; - $SH->print("Hi there!"); - print "I got: ", ${$SH->sref}, "\n"; ### get at value - -If your Perl is 5.004 or later, you can use the TIEHANDLE -interface, and read/write scalars just like files: - - use IO::Scalar; - - ### Writing to a scalar... - my $s; - tie *OUT, 'IO::Scalar', \$s; - print OUT "line 1\nline 2\n", "line 3\n"; - print "s is now... $s\n" - - ### Reading and writing an anonymous scalar... - tie *OUT, 'IO::Scalar'; - print OUT "line 1\nline 2\n", "line 3\n"; - tied(OUT)->seek(0,0); - while (<OUT>) { print "LINE: ", $_ } - -Stringification now works, too! - - my $SH = new IO::Scalar \$somestring; - $SH->print("Hello, "); - $SH->print("world!"); - print "I've got: <$SH>\n"; - -You can also make the objects sensitive to the $/ setting, -just like IO::Handle wants them to be: - - my $SH = new IO::Scalar \$somestring; - $SH->use_RS(1); ### perlvar's short name for $/ - ... - local $/ = ""; ### read paragraph-at-a-time - $nextpar = $SH->getline; - - - -=head1 DESCRIPTION - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) scalars. They can be tiehandle'd as well. - -Basically, this: - - my $s; - $SH = new IO::Scalar \$s; - $SH->print("Hel", "lo, "); # OO style - $SH->print("world!\n"); # ditto - -Or this (if you have 5.004 or later): - - my $s; - $SH = tie *OUT, 'IO::Scalar', \$s; - print OUT "Hel", "lo, "; # non-OO style - print OUT "world!\n"; # ditto - -Or this (if you have 5.004 or later): - - my $s; - $SH = IO::Scalar->new_tie(\$s); - $SH->print("Hel", "lo, "); # OO style... - print $SH "world!\n"; # ...or non-OO style! - -Causes $s to be set to: - - "Hello, world!\n" - - -=head1 PUBLIC INTERFACE - -=cut - -use Carp; -use strict; -use vars qw($VERSION @ISA); -use IO::Handle; - -### Stringification, courtesy of B. K. Oxley (binkley): :-) -use overload '""' => sub { ${$_[0]->{SR}} }; -use overload 'bool' => sub { 1 }; ### have to do this, so object is true! - -### The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - -### Inheritance: -@ISA = qw(IO::Handle); -require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004); - -#============================== - -=head2 Construction - -=over 4 - -=cut - -#------------------------------ - -=item new [ARGS...] - -I<Class method.> -Return a new, unattached scalar handle. -If any arguments are given, they're sent to open(). - -=cut - -sub new { - my $self = bless {}, shift; - $self->open(@_) if @_; - $self; -} -sub DESTROY { - shift->close; -} - -#------------------------------ - -=item open [SCALARREF] - -I<Instance method.> -Open the scalar handle on a new scalar, pointed to by SCALARREF. -If no SCALARREF is given, a "private" scalar is created to hold -the file data. - -Returns the self object on success, undefined on error. - -=cut - -sub open { - my ($self, $sref) = @_; - - # Sanity: - defined($sref) or do {my $s = ''; $sref = \$s}; - (ref($sref) eq "SCALAR") or croak "open() needs a ref to a scalar"; - - # Setup: - $self->{Pos} = 0; ### seek position - $self->{SR} = $sref; ### scalar reference - $self; -} - -#------------------------------ - -=item opened - -I<Instance method.> -Is the scalar handle opened on something? - -=cut - -sub opened { - shift->{SR}; -} - -#------------------------------ - -=item close - -I<Instance method.> -Disassociate the scalar handle from its underlying scalar. -Done automatically on destroy. - -=cut - -sub close { - my $self = shift; - %$self = (); - 1; -} - -=back - -=cut - - - -#============================== - -=head2 Input and output - -=over 4 - -=cut - - -#------------------------------ - -=item flush - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub flush {} - -#------------------------------ - -=item getc - -I<Instance method.> -Return the next character, or undef if none remain. - -=cut - -sub getc { - my $self = shift; - - # Return undef right away if at EOF; else, move pos forward: - return undef if $self->eof; - substr(${$self->{SR}}, $self->{Pos}++, 1); -} - -#------------------------------ - -=item getline - -I<Instance method.> -Return the next line, or undef on end of string. -Can safely be called in an array context. -Currently, lines are delimited by "\n". - -=cut - -sub getline { - my $self = shift; - - # Return undef right away if at EOF: - return undef if $self->eof; - - # Get next line: - my $sr = $self->{SR}; - my $i = $self->{Pos}; # Start matching at this point. - - ### Minimal impact implementation! - ### We do the fast fast thing (no regexps) if using the - ### classic input record separator. - my $RS = $self->{UseRS} ? $/ : "\012"; - - ### Case 1: $RS is undef: slurp all... - if (!defined($RS)) { - $self->{Pos} = length $$sr; - return substr($$sr, $i); - } - - ### Case 2: $RS is "\n": zoom zoom zoom... - elsif ($RS eq "\012") { - - ### Seek ahead for "\n"... yes, this really is faster than regexps. - my $len = length($$sr); - for (; $i < $len; ++$i) { - last if ord (substr ($$sr, $i, 1)) == 10; - } - - ### Extract the line: - my $line; - if ($i < $len) { ### We found a "\n": - $line = substr ($$sr, $self->{Pos}, $i - $self->{Pos} + 1); - $self->{Pos} = $i+1; ### Remember where we finished up. - } - else { ### No "\n"; slurp the remainder: - $line = substr ($$sr, $self->{Pos}, $i - $self->{Pos}); - $self->{Pos} = $len; - } - return $line; - } - - ### Case 3: $RS is ref to int. Bail out. - elsif (ref($RS)) { - croak '$RS as ref to int is currently unsupported'; - } - - ### Case 4: $RS is either "" (paragraphs) or something weird... - ### This is Graham's general-purpose stuff, which might be - ### a tad slower than Case 2 for typical data, because - ### of the regexps. - else { - pos($$sr) = $i; - - ### If in paragraph mode, skip leading lines (and update i!): - length($RS) or - (($$sr =~ m/\G\n*/g) and ($i = pos($$sr))); - - ### If we see the separator in the buffer ahead... - if (length($RS) - ? $$sr =~ m,\Q$RS\E,g ### (ordinary sep) TBD: precomp! - : $$sr =~ m,\n\n,g ### (a paragraph) - ) { - $self->{Pos} = pos $$sr; - return substr($$sr, $i, $self->{Pos}-$i); - } - ### Else if no separator remains, just slurp the rest: - else { - $self->{Pos} = length $$sr; - return substr($$sr, $i); - } - } -} - -#------------------------------ - -=item getlines - -I<Instance method.> -Get all remaining lines. -It will croak() if accidentally called in a scalar context. - -=cut - -sub getlines { - my $self = shift; - wantarray or croak("Can't call getlines in scalar context!"); - my ($line, @lines); - push @lines, $line while (defined($line = $self->getline)); - @lines; -} - -#------------------------------ - -=item print ARGS... - -I<Instance method.> -Print ARGS to the underlying scalar. - -B<Warning:> Currently, this always causes a "seek to the end of the string"; -this may change in the future. - -=cut - -sub print { - my $self = shift; - ${$self->{SR}} .= join('', @_); - $self->{Pos} = length(${$self->{SR}}); - 1; -} - -#------------------------------ - -=item read BUF, NBYTES, [OFFSET] - -I<Instance method.> -Read some bytes from the scalar. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -=cut - -sub read { - my $self = $_[0]; - my $n = $_[2]; - my $off = $_[3] || 0; - - my $read = substr(${$self->{SR}}, $self->{Pos}, $n); - $n = length($read); - $self->{Pos} += $n; - ($off ? substr($_[1], $off) : $_[1]) = $read; - return $n; -} - -#------------------------------ - -=item write BUF, NBYTES, [OFFSET] - -I<Instance method.> -Write some bytes to the scalar. - -=cut - -sub write { - my $self = $_[0]; - my $n = $_[2]; - my $off = $_[3] || 0; - - my $data = substr($_[1], $off, $n); - $n = length($data); - $self->print($data); - return $n; -} - -#------------------------------ - -=item sysread BUF, LEN, [OFFSET] - -I<Instance method.> -Read some bytes from the scalar. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -=cut - -sub sysread { - my $self = shift; - $self->read (@_); -} - -#------------------------------ - -=item syswrite BUF, NBYTES, [OFFSET] - -I<Instance method.> -Write some bytes to the scalar. - -=cut - -sub syswrite { - my $self = shift; - $self->write (@_); -} - -=back - -=cut - - -#============================== - -=head2 Seeking/telling and other attributes - -=over 4 - -=cut - - -#------------------------------ - -=item autoflush - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub autoflush {} - -#------------------------------ - -=item binmode - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub binmode {} - -#------------------------------ - -=item clearerr - -I<Instance method.> Clear the error and EOF flags. A no-op. - -=cut - -sub clearerr { 1 } - -#------------------------------ - -=item eof - -I<Instance method.> Are we at end of file? - -=cut - -sub eof { - my $self = shift; - ($self->{Pos} >= length(${$self->{SR}})); -} - -#------------------------------ - -=item seek OFFSET, WHENCE - -I<Instance method.> Seek to a given position in the stream. - -=cut - -sub seek { - my ($self, $pos, $whence) = @_; - my $eofpos = length(${$self->{SR}}); - - # Seek: - if ($whence == 0) { $self->{Pos} = $pos } # SEEK_SET - elsif ($whence == 1) { $self->{Pos} += $pos } # SEEK_CUR - elsif ($whence == 2) { $self->{Pos} = $eofpos + $pos} # SEEK_END - else { croak "bad seek whence ($whence)" } - - # Fixup: - if ($self->{Pos} < 0) { $self->{Pos} = 0 } - if ($self->{Pos} > $eofpos) { $self->{Pos} = $eofpos } - 1; -} - -#------------------------------ - -=item sysseek OFFSET, WHENCE - -I<Instance method.> Identical to C<seek OFFSET, WHENCE>, I<q.v.> - -=cut - -sub sysseek { - my $self = shift; - $self->seek (@_); -} - -#------------------------------ - -=item tell - -I<Instance method.> -Return the current position in the stream, as a numeric offset. - -=cut - -sub tell { shift->{Pos} } - -#------------------------------ - -=item use_RS [YESNO] - -I<Instance method.> -Obey the curent setting of $/, like IO::Handle does? -Default is false. - -=cut - -sub use_RS { - my ($self, $yesno) = @_; - $self->{UseRS} = $yesno; -} - -#------------------------------ - -=item setpos POS - -I<Instance method.> -Set the current position, using the opaque value returned by C<getpos()>. - -=cut - -sub setpos { shift->seek($_[0],0) } - -#------------------------------ - -=item getpos - -I<Instance method.> -Return the current position in the string, as an opaque object. - -=cut - -*getpos = \&tell; - - -#------------------------------ - -=item sref - -I<Instance method.> -Return a reference to the underlying scalar. - -=cut - -sub sref { shift->{SR} } - - -#------------------------------ -# Tied handle methods... -#------------------------------ - -# Conventional tiehandle interface: -sub TIEHANDLE { shift->new(@_) } -sub GETC { shift->getc(@_) } -sub PRINT { shift->print(@_) } -sub PRINTF { shift->print(sprintf(shift, @_)) } -sub READ { shift->read(@_) } -sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } -sub WRITE { shift->write(@_); } -sub CLOSE { shift->close(@_); } - -#------------------------------------------------------------ - -1; - -__END__ - - - -=back - -=cut - -=head1 VERSION - -$Id: Scalar.pm,v 1.999 2001-03-30 03:13:03 dparker Exp $ - - -=head1 AUTHORS - - -=head2 Principal author - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - - -=head2 Other contributors - -The full set of contributors always includes the folks mentioned -in L<IO::Stringy/"CHANGE LOG">. But just the same, special -thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - -I<Andy Glew,> -for contributing C<getc()>. - -I<Brandon Browning,> -for suggesting C<opened()>. - -I<David Richter,> -for finding and fixing the bug in C<PRINTF()>. - -I<Eric L. Brine,> -for his offset-using read() and write() implementations. - -I<Richard Jones,> -for his patches to massively improve the performance of C<getline()> -and add C<sysread> and C<syswrite>. - -I<B. K. Oxley (binkley),> -for stringification and inheritance improvements, -and sundry good ideas. - - -=cut diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/ScalarArray.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/ScalarArray.pm deleted file mode 100644 index 8f844e3..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/ScalarArray.pm +++ /dev/null @@ -1,598 +0,0 @@ -package IO::ScalarArray; - - -=head1 NAME - -IO::ScalarArray - IO:: interface for reading/writing an array of scalars - - -=head1 SYNOPSIS - -If you have any Perl5, you can use the basic OO interface... - - use IO::ScalarArray; - - # Open a handle on an array-of-scalars: - $AH = new IO::ScalarArray; - $AH->open(\@a); - - # Open a handle on an array-of-scalars, read it line-by-line, - # then close it: - $AH = new IO::ScalarArray \@a; - while ($_ = $AH->getline) { print "Line: $_" } - $AH->close; - - # Open a handle on an array-of-scalars, and slurp in all the lines: - $AH = new IO::ScalarArray \@a; - print $AH->getlines; - - # Open a handle on an array-of-scalars, and append to it: - $AH = new IO::ScalarArray \@a; - $AH->print("bar\n"); - print "some string is now: ", $somestring, "\n"; - - # Get the current position: - $pos = $AH->getpos; ### $AH->tell() also works - - # Set the current position: - $AH->setpos($pos); ### $AH->seek(POS,WHENCE) also works - - # Open an anonymous temporary scalar array: - $AH = new IO::ScalarArray; - $AH->print("Hi there!\nHey there!\n"); - $AH->print("Ho there!\n"); - print "I got: ", @{$AH->aref}, "\n"; ### get at value - -If your Perl is 5.004 or later, you can use the TIEHANDLE -interface, and read/write as array-of-scalars just like files: - - use IO::ScalarArray; - - # Writing to a scalar array... - my @a; - tie *OUT, 'IO::ScalarArray', \@a; - print OUT "line 1\nline 2\n", "line 3\n"; - print "s is now... [", join('', @a), "]\n"; - - # Reading and writing an anonymous scalar array... - tie *OUT, 'IO::ScalarArray'; - print OUT "line 1\nline 2\n", "line 3\n"; - tied(OUT)->seek(0,0); - while (<OUT>) { print "LINE: ", $_ } - - -=head1 DESCRIPTION - -This class implements objects which behave just like FileHandle -(or IO::Handle) objects, except that you may use them to write to -(or read from) scalars. They can be tiehandle'd as well. - -For writing large amounts of data with individual print() statements, -this is likely to be more efficient than IO::Scalar. - -Basically, this: - - my @a; - $AH = new IO::ScalarArray \@a; - $AH->print("Hel", "lo, "); - $AH->print("world!\n"); - -Or this (if you have 5.004 or later): - - my @a; - $AH = tie *OUT, 'IO::ScalarArray', \@a; - print OUT "Hel", "lo, "; - print OUT "world!\n"; - -Causes @a to be set to the following arrayt of 3 strings: - - ( "Hel" , - "lo, " , - "world!\n" ) - -Compare this with IO::Scalar. - - -=head1 PUBLIC INTERFACE - -=cut - -use Carp; -use strict; -use vars qw($VERSION @ISA); -use IO::Handle; - -# The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - -# Inheritance: -@ISA = qw(IO::Handle); -require IO::WrapTie and push @ISA, 'IO::WrapTie::Slave' if ($] >= 5.004); - - -#============================== - -=head2 Construction - -=over 4 - -=cut - -#------------------------------ - -=item new [ARGS...] - -I<Class method.> -Return a new, unattached array handle. -If any arguments are given, they're sent to open(). - -=cut - -sub new { - my $self = bless {}, shift; - $self->open(@_) if @_; - $self; -} -sub DESTROY { - shift->close; -} - - -#------------------------------ - -=item open [ARRAYREF] - -I<Instance method.> -Open the array handle on a new array, pointed to by ARRAYREF. -If no ARRAYREF is given, a "private" array is created to hold -the file data. - -Returns the self object on success, undefined on error. - -=cut - -sub open { - my ($self, $aref) = @_; - - # Sanity: - defined($aref) or do {my @a; $aref = \@a}; - (ref($aref) eq "ARRAY") or croak "open needs a ref to a array"; - - # Setup: - $self->setpos([0,0]); - $self->{AR} = $aref; - $self; -} - -#------------------------------ - -=item opened - -I<Instance method.> -Is the array handle opened on something? - -=cut - -sub opened { - shift->{AR}; -} - -#------------------------------ - -=item close - -I<Instance method.> -Disassociate the array handle from its underlying array. -Done automatically on destroy. - -=cut - -sub close { - my $self = shift; - %$self = (); - 1; -} - -=back - -=cut - - - -#============================== - -=head2 Input and output - -=over 4 - -=cut - -#------------------------------ - -=item flush - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub flush {} - -#------------------------------ - -=item getc - -I<Instance method.> -Return the next character, or undef if none remain. -This does a read(1), which is somewhat costly. - -=cut - -sub getc { - my $buf = ''; - ($_[0]->read($buf, 1) ? $buf : undef); -} - -#------------------------------ - -=item getline - -I<Instance method.> -Return the next line, or undef on end of data. -Can safely be called in an array context. -Currently, lines are delimited by "\n". - -=cut - -sub getline { - my $self = shift; - my ($str, $line) = (undef, ''); - - # Until we hit EOF (or exitted because of a found line): - until ($self->eof) { - # If at end of current string, go forward to next one (won't be EOF): - if ($self->_eos) {++$self->{Str}, $self->{Pos}=0}; - - # Get ref to current string in array, and set internal pos marker: - $str = \($self->{AR}[$self->{Str}]); # get current string - pos($$str) = $self->{Pos}; # start matching at this point - - # Get from here to either newline or end of string, and add to line: - $$str =~ m/\G(.*?)((\n)|\Z)/g; # match to 1st newline or EOS - $line .= $1.$2; # add it - $self->{Pos} += length($1.$2); # move forward by amount matched - return $line if $3; # done, got a line with "\n" - } - return ($line eq '') ? undef : $line; # return undef if EOF -} - -#------------------------------ - -=item getlines - -I<Instance method.> -Get all remaining lines. -It will croak() if accidentally called in a scalar context. - -=cut - -sub getlines { - my $self = shift; - wantarray or croak("Can't call getlines in scalar context!"); - my ($line, @lines); - push @lines, $line while (defined($line = $self->getline)); - @lines; -} - -#------------------------------ - -=item print ARGS... - -I<Instance method.> -Print ARGS to the underlying array. - -Currently, this always causes a "seek to the end of the array" -and generates a new array entry. This may change in the future. - -=cut - -sub print { - my $self = shift; - push @{$self->{AR}}, join('', @_); # add the data - $self->setpos([scalar(@{$self->{AR}}), 0]); - 1; -} - -#------------------------------ - -=item read BUF, NBYTES, [OFFSET]; - -I<Instance method.> -Read some bytes from the array. -Returns the number of bytes actually read, 0 on end-of-file, undef on error. - -=cut - -sub read { - my $self = $_[0]; - my $n = $_[2]; - my $off = $_[3] || 0; - - ### print "getline\n"; - my $justread; - my $len; - ($off ? substr($_[1], $off) : $_[1]) = ''; - - # Stop when we have zero bytes to go, or when we hit EOF: - until (!$n or $self->eof) { - # If at end of current string, go forward to next one (won't be EOF): - if ($self->_eos) { - ++$self->{Str}; - $self->{Pos} = 0; - } - - # Get longest possible desired substring of current string: - $justread = substr($self->{AR}[$self->{Str}], $self->{Pos}, $n); - $len = length($justread); - $_[1] .= $justread; - $n -= $len; - $self->{Pos} += $len; - } - return length($_[1])-$off; -} - -#------------------------------ - -=item write BUF, NBYTES, [OFFSET]; - -I<Instance method.> -Write some bytes into the array. - -=cut - -sub write { - my $self = $_[0]; - my $n = $_[2]; - my $off = $_[3] || 0; - - my $data = substr($_[1], $n, $off); - $n = length($data); - $self->print($data); - return $n; -} - - -=back - -=cut - - - -#============================== - -=head2 Seeking/telling and other attributes - -=over 4 - -=cut - -#------------------------------ - -=item autoflush - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub autoflush {} - -#------------------------------ - -=item binmode - -I<Instance method.> -No-op, provided for OO compatibility. - -=cut - -sub binmode {} - -#------------------------------ - -=item clearerr - -I<Instance method.> Clear the error and EOF flags. A no-op. - -=cut - -sub clearerr { 1 } - -#------------------------------ - -=item eof - -I<Instance method.> Are we at end of file? - -=cut - -sub eof { - ### print "checking EOF [$self->{Str}, $self->{Pos}]\n"; - ### print "SR = ", $#{$self->{AR}}, "\n"; - return 0 if ($_[0]->{Str} < $#{$_[0]->{AR}}); # before EOA - return 1 if ($_[0]->{Str} > $#{$_[0]->{AR}}); # after EOA - (($_[0]->{Str} == $#{$_[0]->{AR}}) && ($_[0]->_eos)); # at EOA, past EOS -} - -#------------------------------ -# -# _eos -# -# I<Instance method, private.> Are we at end of the CURRENT string? -# - -sub _eos { - ($_[0]->{Pos} >= length($_[0]->{AR}[$_[0]->{Str}])); # past last char -} - -#------------------------------ - -=item seek POS,WHENCE - -I<Instance method.> -Seek to a given position in the stream. -Only a WHENCE of 0 (SEEK_SET) is supported. - -=cut - -sub seek { - my ($self, $pos, $whence) = @_; - die "IO::ScalarArray::seek: whence of $whence not supported\n" if $whence; - - # Advance through array until done: - my $istr = 0; - while (($pos >= 0) && ($istr < scalar(@{$self->{AR}}))) { - if (length($self->{AR}[$istr]) > $pos) { # it's in this string! - return $self->setpos([$istr, $pos]); - } - else { # it's in next string - $pos -= length($self->{AR}[$istr++]); # move forward one string - } - } - # If we reached this point, pos is at or past end; zoom to EOF: - return $self->setpos([scalar(@{$self->{AR}}), 0]); -} - -#------------------------------ - -=item tell - -I<Instance method.> -Return the current position in the stream, as a numeric offset. - -=cut - -sub tell { - my $self = shift; - my $off = 0; - my ($s, $str_s); - for ($s = 0; $s < $self->{Str}; $s++) { # count all "whole" scalars - defined($str_s = $self->{AR}[$s]) or $str_s = ''; - ###print STDERR "COUNTING STRING $s (". length($str_s) . ")\n"; - $off += length($str_s); - } - ###print STDERR "COUNTING POS ($self->{Pos})\n"; - return ($off += $self->{Pos}); # plus the final, partial one -} - -#------------------------------ - -=item setpos POS - -I<Instance method.> -Seek to a given position in the array, using the opaque getpos() value. -Don't expect this to be a number. - -=cut - -sub setpos { - my ($self, $pos) = @_; - (ref($pos) eq 'ARRAY') or - die "setpos: only use a value returned by getpos!\n"; - ($self->{Str}, $self->{Pos}) = @$pos; -} - -#------------------------------ - -=item getpos - -I<Instance method.> -Return the current position in the array, as an opaque value. -Don't expect this to be a number. - -=cut - -sub getpos { - [$_[0]->{Str}, $_[0]->{Pos}]; -} - -#------------------------------ - -=item aref - -I<Instance method.> -Return a reference to the underlying array. - -=cut - -sub aref { - shift->{AR}; -} - -=back - -=cut - -#------------------------------ -# Tied handle methods... -#------------------------------ - -# Conventional tiehandle interface: -sub TIEHANDLE { shift->new(@_) } -sub GETC { shift->getc(@_) } -sub PRINT { shift->print(@_) } -sub PRINTF { shift->print(sprintf(shift, @_)) } -sub READ { shift->read(@_) } -sub READLINE { wantarray ? shift->getlines(@_) : shift->getline(@_) } -sub WRITE { shift->write(@_); } -sub CLOSE { shift->close(@_); } - -#------------------------------------------------------------ - -1; -__END__ - -# SOME PRIVATE NOTES: -# -# * The "current position" is the position before the next -# character to be read/written. -# -# * Str gives the string index of the current position, 0-based -# -# * Pos gives the offset within AR[Str], 0-based. -# -# * Inital pos is [0,0]. After print("Hello"), it is [1,0]. - - -=head1 VERSION - -$Id: ScalarArray.pm,v 1.999 2001-03-30 03:11:52 dparker Exp $ - - -=head1 AUTHOR - -=head2 Principal author - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - - -=head2 Other contributors - -Thanks to the following individuals for their invaluable contributions -(if I've forgotten or misspelled your name, please email me!): - -I<Andy Glew,> -for suggesting C<getc()>. - -I<Brandon Browning,> -for suggesting C<opened()>. - -I<Eric L. Brine,> -for his offset-using read() and write() implementations. - -=cut - -#------------------------------ -1; - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Stringy.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Stringy.pm deleted file mode 100644 index 74c4ef1..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Stringy.pm +++ /dev/null @@ -1,290 +0,0 @@ -package IO::Stringy; - -use vars qw($VERSION); -$VERSION = substr q$Revision: 1.999 $, 10; - -1; -__END__ - - -=head1 NAME - -IO-stringy - I/O on in-core objects like strings and arrays - - -=head1 SYNOPSIS - - IO:: - ::AtomicFile adpO Write a file which is updated atomically ERYQ - ::Lines bdpO I/O handle to read/write to array of lines ERYQ - ::Scalar RdpO I/O handle to read/write to a string ERYQ - ::ScalarArray RdpO I/O handle to read/write to array of scalars ERYQ - ::Wrap RdpO Wrap old-style FHs in standard OO interface ERYQ - ::WrapTie adpO Tie your handles & retain full OO interface ERYQ - - -=head1 DESCRIPTION - -This toolkit primarily provides modules for performing both traditional -and object-oriented i/o) on things I<other> than normal filehandles; -in particular, L<IO::Scalar|IO::Scalar>, L<IO::ScalarArray|IO::ScalarArray>, -and L<IO::Lines|IO::Lines>. - -If you have access to tie(), these classes will make use of the -L<IO::WrapTie|IO::WrapTie> module to inherit a convenient new_tie() -constructor. It also exports a nice wraptie() function. - -In the more-traditional IO::Handle front, we -have L<IO::AtomicFile|IO::AtomicFile> -which may be used to painlessly create files which are updated -atomically. - -And in the "this-may-prove-useful" corner, we have L<IO::Wrap|IO::Wrap>, -whose exported wraphandle() function will clothe anything that's not -a blessed object in an IO::Handle-like wrapper... so you can just -use OO syntax and stop worrying about whether your function's caller -handed you a string, a globref, or a FileHandle. - - -=head1 INSTALLATION - -Most of you already know the drill... - - perl Makefile.PL - make test - make install - -For everyone else out there... -if you've never installed Perl code before, or you're trying to use -this in an environment where your sysadmin or ISP won't let you do -interesting things, B<relax:> since this module contains no binary -extensions, you can cheat. That means copying the directory tree -under my "./lib" directory into someplace where your script can "see" -it. For example, under Linux: - - cp -r IO-stringy-1.234/lib/* /path/to/my/perl/ - -Now, in your Perl code, do this: - - use lib "/path/to/my/perl"; - use IO::Scalar; ### or whatever - -Ok, now you've been told. At this point, anyone who whines about -not being given enough information gets an unflattering haiku -written about them in the next change log. I'll do it. -Don't think I won't. - - - -=head1 VERSION - -$Id: Stringy.pm,v 1.999 2001-03-30 03:13:03 dparker Exp $ - - - -=head1 TO DO - -=over 4 - -=item (2000/08/02) Finalize $/ support - -Graham Barr submitted this patch half a I<year> ago; -Like a moron, I lost his message under a ton of others, -and only now have the experimental implementation done. - -Will the sudden sensitivity to $/ hose anyone out there? -I'm worried, so you have to enable it explicitly. - - -=item (2000/09/28) Separate read/write cursors? - -Binkley sent me a very interesting variant of IO::Scalar which -maintains two separate cursors on the data, one for reading -and one for writing. Quoth he: - - Isn't it the case that real operating system file descriptors - maintain an independent read and write file position (and - seek(2) resets them both)? - -He also pointed out some issues with his implementation: - - For example, what does eof or tell return? The read position or - the write position? (I assumed read position was more important). - -Your opinions on this are most welcome. -(Me, I'm just squeamish that this will break some code -which depends on the existing behavior, and that attempts to -maintain backwards-compatibility will slow down the code. -But I'll give it a shot.) - -=back - - - -=head1 CHANGE LOG - -=over 4 - -=item Version 1.219 (2001/02/23) - -IO::Scalar objects can now be made sensitive to $/ . -Pains were taken to keep the fast code fast while adding this feature. -I<Cheers to Graham Barr for submitting his patch; -jeers to me for losing his email for 6 months.> - - -=item Version 1.218 (2001/02/23) - -IO::Scalar has a new sysseek() method. -I<Thanks again to Richard Jones.> - -New "TO DO" section, because people who submit patches/ideas should -at least know that they're in the system... and that I won't lose -their stuff. Please read it. - -New entries in L<"AUTHOR">. -Please read those too. - - - -=item Version 1.216 (2000/09/28) - -B<IO::Scalar and IO::ScalarArray now inherit from IO::Handle.> -I thought I'd remembered a problem with this ages ago, related to -the fact that these IO:: modules don't have "real" filehandles, -but the problem apparently isn't surfacing now. -If you suddenly encounter Perl warnings during global destruction -(especially if you're using tied filehandles), then please let me know! -I<Thanks to B. K. Oxley (binkley) for this.> - -B<Nasty bug fixed in IO::Scalar::write().> -Apparently, the offset and the number-of-bytes arguments were, -for all practical purposes, I<reversed.> You were okay if -you did all your writing with print(), but boy was I<this> a stupid bug! -I<Thanks to Richard Jones for finding this one. -For you, Rich, a double-length haiku:> - - Newspaper headline - typeset by dyslexic man - loses urgency - - BABY EATS FISH is - simply not equivalent - to FISH EATS BABY - -B<New sysread and syswrite methods for IO::Scalar.> -I<Thanks again to Richard Jones for this.> - - -=item Version 1.215 (2000/09/05) - -Added 'bool' overload to '""' overload, so object always evaluates -to true. (Whew. Glad I caught this before it went to CPAN.) - - -=item Version 1.214 (2000/09/03) - -Evaluating an IO::Scalar in a string context now yields -the underlying string. -I<Thanks to B. K. Oxley (binkley) for this.> - - -=item Version 1.213 (2000/08/16) - -Minor documentation fixes. - - -=item Version 1.212 (2000/06/02) - -Fixed IO::InnerFile incompatibility with Perl5.004. -I<Thanks to many folks for reporting this.> - - -=item Version 1.210 (2000/04/17) - -Added flush() and other no-op methods. -I<Thanks to Doru Petrescu for suggesting this.> - - -=item Version 1.209 (2000/03/17) - -Small bug fixes. - - -=item Version 1.208 (2000/03/14) - -Incorporated a number of contributed patches and extensions, -mostly related to speed hacks, support for "offset", and -WRITE/CLOSE methods. -I<Thanks to Richard Jones, Doru Petrescu, and many others.> - - - -=item Version 1.206 (1999/04/18) - -Added creation of ./testout when Makefile.PL is run. - - -=item Version 1.205 (1999/01/15) - -Verified for Perl5.005. - - -=item Version 1.202 (1998/04/18) - -New IO::WrapTie and IO::AtomicFile added. - - -=item Version 1.110 - -Added IO::WrapTie. - - -=item Version 1.107 - -Added IO::Lines, and made some bug fixes to IO::ScalarArray. -Also, added getc(). - - -=item Version 1.105 - -No real changes; just upgraded IO::Wrap to have a $VERSION string. - -=back - - - - -=head1 AUTHOR - -=over 4 - -=item Primary Maintainer - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - -=item Unofficial Co-Authors - -For all their bug reports and patch submissions, the following -are officially recognized: - - Richard Jones - B. K. Oxley (binkley) - Doru Petrescu - - -=back - -Enjoy. Yell if it breaks. - - -=cut - - - - - - - - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Wrap.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Wrap.pm deleted file mode 100644 index 5ccec9c..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/Wrap.pm +++ /dev/null @@ -1,211 +0,0 @@ -package IO::Wrap; - -# SEE DOCUMENTATION AT BOTTOM OF FILE - -require 5.002; - -use strict; -use vars qw(@ISA @EXPORT $VERSION); -@ISA = qw(Exporter); -@EXPORT = qw(wraphandle); - -use FileHandle; -use Carp; - -# The package version, both in 1.23 style *and* usable by MakeMaker: -$VERSION = substr q$Revision: 1.999 $, 10; - - -#------------------------------ -# wraphandle RAW -#------------------------------ -sub wraphandle { - my $raw = shift; - new IO::Wrap $raw; -} - -#------------------------------ -# new STREAM -#------------------------------ -sub new { - my ($class, $stream) = @_; - no strict 'refs'; - - # Convert raw scalar to globref: - ref($stream) or $stream = \*$stream; - - # Wrap globref and incomplete objects: - if ((ref($stream) eq 'GLOB') or # globref - (ref($stream) eq 'FileHandle') && !defined(&FileHandle::read)) { - return bless \$stream, $class; - } - $stream; # already okay! -} - -#------------------------------ -# I/O methods... -#------------------------------ -sub close { - my $self = shift; - return close($$self); -} -sub getline { - my $self = shift; - my $fh = $$self; - return scalar(<$fh>); -} -sub getlines { - my $self = shift; - wantarray or croak("Can't call getlines in scalar context!"); - my $fh = $$self; - <$fh>; -} -sub print { - my $self = shift; - print { $$self } @_; -} -sub read { - my $self = shift; - return read($$self, $_[0], $_[1]); -} -sub seek { - my $self = shift; - return seek($$self, $_[0], $_[1]); -} -sub tell { - my $self = shift; - return tell($$self); -} - -#------------------------------ -1; -__END__ - - -=head1 NAME - -IO::Wrap - wrap raw filehandles in IO::Handle interface - - -=head1 SYNOPSIS - - use IO::Wrap; - - # Do stuff with any kind of filehandle (including a bare globref), or - # any kind of blessed object that responds to a print() message. - # - sub do_stuff { - my $fh = shift; - - ### At this point, we have no idea what the user gave us... - ### a globref? a FileHandle? a scalar filehandle name? - - $fh = wraphandle($fh); - - ### At this point, we know we have an IO::Handle-like object! - - $fh->print("Hey there!"); - ... - } - - -=head1 DESCRIPTION - -Let's say you want to write some code which does I/O, but you don't -want to force the caller to provide you with a FileHandle or IO::Handle -object. You want them to be able to say: - - do_stuff(\*STDOUT); - do_stuff('STDERR'); - do_stuff($some_FileHandle_object); - do_stuff($some_IO_Handle_object); - -And even: - - do_stuff($any_object_with_a_print_method); - -Sure, one way to do it is to force the caller to use tiehandle(). -But that puts the burden on them. Another way to do it is to -use B<IO::Wrap>, which provides you with the following functions: - - -=over 4 - -=item wraphandle SCALAR - -This function will take a single argument, and "wrap" it based on -what it seems to be... - -=over 4 - -=item * - -B<A raw scalar filehandle name,> like C<"STDOUT"> or C<"Class::HANDLE">. -In this case, the filehandle name is wrapped in an IO::Wrap object, -which is returned. - -=item * - -B<A raw filehandle glob,> like C<\*STDOUT>. -In this case, the filehandle glob is wrapped in an IO::Wrap object, -which is returned. - -=item * - -B<A blessed FileHandle object.> -In this case, the FileHandle is wrapped in an IO::Wrap object if and only -if your FileHandle class does not support the C<read()> method. - -=item * - -B<Any other kind of blessed object,> which is assumed to be already -conformant to the IO::Handle interface. -In this case, you just get back that object. - -=back - -=back - - -If you get back an IO::Wrap object, it will obey a basic subset of -the IO:: interface. That is, the following methods (note: I said -I<methods>, not named operators) should work on the thing you get back: - - close - getline - getlines - print ARGS... - read BUFFER,NBYTES - seek POS,WHENCE - tell - - - -=head1 NOTES - -Clearly, when wrapping a raw external filehandle (like \*STDOUT), -I didn't want to close the file descriptor when the "wrapper" object is -destroyed... since the user might not appreciate that! Hence, -there's no DESTROY method in this class. - -When wrapping a FileHandle object, however, I believe that Perl will -invoke the FileHandle::DESTROY when the last reference goes away, -so in that case, the filehandle is closed if the wrapped FileHandle -really was the last reference to it. - - -=head1 WARNINGS - -This module does not allow you to wrap filehandle names which are given -as strings that lack the package they were opened in. That is, if a user -opens FOO in package Foo, they must pass it to you either as C<\*FOO> -or as C<"Foo::FOO">. However, C<"STDIN"> and friends will work just fine. - - -=head1 AUTHOR - -Eryq (F<eryq(a)zeegee.com>). -President, ZeeGee Software Inc (F<http://www.zeegee.com>). - -=cut - diff --git a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/WrapTie.pm b/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/WrapTie.pm deleted file mode 100644 index aada8e6..0000000 --- a/monitoring/PerlModules/CPAN/IO-stringy-1.219/lib/IO/WrapTie.pm +++ /dev/null @@ -1,480 +0,0 @@ -# SEE DOCUMENTATION AT BOTTOM OF FILE - - -#------------------------------------------------------------ -package IO::WrapTie; -#------------------------------------------------------------ -require 5.004; # for tie -use strict; -use vars qw(@ISA @EXPORT $VERSION); -use Exporter; - -# Inheritance, exporting, and package version: -@ISA = qw(Exporter); -@EXPORT = qw(wraptie); -$VERSION = substr q$Revision: 1.999 $, 10; - -# Function, exported. -sub wraptie { - IO::WrapTie::Master->new(@_); -} - -# Class method; BACKWARDS-COMPATIBILITY ONLY! -sub new { - shift; - IO::WrapTie::Master->new(@_); -} - - - -#------------------------------------------------------------ -package IO::WrapTie::Master; -#------------------------------------------------------------ - -use strict; -use vars qw(@ISA $AUTOLOAD); -use IO::Handle; - -# We inherit from IO::Handle to get methods which invoke i/o operators, -# like print(), on our tied handle: -@ISA = qw(IO::Handle); - -#------------------------------ -# new SLAVE, TIEARGS... -#------------------------------ -# Create a new subclass of IO::Handle which... -# -# (1) Handles i/o OPERATORS because it is tied to an instance of -# an i/o-like class, like IO::Scalar. -# -# (2) Handles i/o METHODS by delegating them to that same tied object!. -# -# Arguments are the slave class (e.g., IO::Scalar), followed by all -# the arguments normally sent into that class's TIEHANDLE method. -# In other words, much like the arguments to tie(). :-) -# -# NOTE: -# The thing $x we return must be a BLESSED REF, for ($x->print()). -# The underlying symbol must be a FILEHANDLE, for (print $x "foo"). -# It has to have a way of getting to the "real" back-end object... -# -sub new { - my $master = shift; - my $io = IO::Handle->new; # create a new handle - my $slave = shift; - tie *$io, $slave, @_; # tie: will invoke slave's TIEHANDLE - bless $io, $master; # return a master -} - -#------------------------------ -# AUTOLOAD -#------------------------------ -# Delegate method invocations on the master to the underlying slave. -# -sub AUTOLOAD { - my $method = $AUTOLOAD; - $method =~ s/.*:://; - my $self = shift; tied(*$self)->$method(\@_); -} - -#------------------------------ -# PRELOAD -#------------------------------ -# Utility. -# -# Most methods like print(), getline(), etc. which work on the tied object -# via Perl's i/o operators (like 'print') are inherited from IO::Handle. -# -# Other methods, like seek() and sref(), we must delegate ourselves. -# AUTOLOAD takes care of these. -# -# However, it may be necessary to preload delegators into your -# own class. PRELOAD will do this. -# -sub PRELOAD { - my $class = shift; - foreach (@_) { - eval "sub ${class}::$_ { my \$s = shift; tied(*\$s)->$_(\@_) }"; - } -} - -# Preload delegators for some standard methods which we can't simply -# inherit from IO::Handle... for example, some IO::Handle methods -# assume that there is an underlying file descriptor. -# -PRELOAD IO::WrapTie::Master - qw(open opened close read clearerr eof seek tell setpos getpos); - - - -#------------------------------------------------------------ -package IO::WrapTie::Slave; -#------------------------------------------------------------ -# Teeny private class providing a new_tie constructor... -# -# HOW IT ALL WORKS: -# -# Slaves inherit from this class. -# -# When you send a new_tie() message to a tie-slave class (like IO::Scalar), -# it first determines what class should provide its master, via TIE_MASTER. -# In this case, IO::Scalar->TIE_MASTER would return IO::Scalar::Master. -# Then, we create a new master (an IO::Scalar::Master) with the same args -# sent to new_tie. -# -# In general, the new() method of the master is inherited directly -# from IO::WrapTie::Master. -# -sub new_tie { - my $self = shift; - $self->TIE_MASTER->new($self,@_); # e.g., IO::Scalar::Master->new(@_) -} - -# Default class method for new_tie(). -# All your tie-slave class (like IO::Scalar) has to do is override this -# method with a method that returns the name of an appropriate "master" -# class for tying that slave. -# -sub TIE_MASTER { 'IO::WrapTie::Master' } - -#------------------------------ -1; -__END__ - - -package IO::WrapTie; # for doc generator - - -=head1 NAME - -IO::WrapTie - wrap tieable objects in IO::Handle interface - -I<This is currently Alpha code, released for comments. - Please give me your feedback!> - - -=head1 SYNOPSIS - -First of all, you'll need tie(), so: - - require 5.004; - -I<Function interface (experimental).> -Use this with any existing class... - - use IO::WrapTie; - use FooHandle; # implements TIEHANDLE interface - - # Suppose we want a "FooHandle->new(&FOO_RDWR, 2)". - # We can instead say... - - $FH = wraptie('FooHandle', &FOO_RDWR, 2); - - # Now we can use... - print $FH "Hello, "; # traditional operator syntax... - $FH->print("world!\n"); # ...and OO syntax as well! - -I<OO interface (preferred).> -You can inherit from the IO::WrapTie::Slave mixin to get a -nifty C<new_tie()> constructor... - - #------------------------------ - package FooHandle; # a class which can TIEHANDLE - - use IO::WrapTie; - @ISA = qw(IO::WrapTie::Slave); # inherit new_tie() - ... - - - #------------------------------ - package main; - - $FH = FooHandle->new_tie(&FOO_RDWR, 2); # $FH is an IO::WrapTie::Master - print $FH "Hello, "; # traditional operator syntax - $FH->print("world!\n"); # OO syntax - -See IO::Scalar as an example. It also shows you how to create classes -which work both with and without 5.004. - - -=head1 DESCRIPTION - -Suppose you have a class C<FooHandle>, where... - -=over 4 - -=item * - -B<FooHandle does not inherit from IO::Handle;> that is, it performs -filehandle-like I/O, but to something other than an underlying -file descriptor. Good examples are IO::Scalar (for printing to a -string) and IO::Lines (for printing to an array of lines). - -=item * - -B<FooHandle implements the TIEHANDLE interface> (see L<perltie>); -that is, it provides methods TIEHANDLE, GETC, PRINT, PRINTF, -READ, and READLINE. - -=item * - -B<FooHandle implements the traditional OO interface> of -FileHandle and IO::Handle; i.e., it contains methods like getline(), -read(),

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

spacewalk-commits October 2011