+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-#
-# DO NOT HAND-EDIT the file named 'Makefile'. This file is autogenerated.
-# Have a look at "configure" and "Makefile.in" instead
-#
-
-
-PERL = /usr/bin/perl
-INSTALL = /usr/bin/install -c
-CC = @CC@
-
-RT_LAYOUT = Freeside
-
-CONFIG_FILE_PATH = /opt/rt3/etc
-CONFIG_FILE = $(CONFIG_FILE_PATH)/RT_Config.pm
-SITE_CONFIG_FILE = $(CONFIG_FILE_PATH)/RT_SiteConfig.pm
-
-
-RT_VERSION_MAJOR = 4
-RT_VERSION_MINOR = 0
-RT_VERSION_PATCH = 22
-
-RT_VERSION = $(RT_VERSION_MAJOR).$(RT_VERSION_MINOR).$(RT_VERSION_PATCH)
-TAG = rt-$(RT_VERSION_MAJOR)-$(RT_VERSION_MINOR)-$(RT_VERSION_PATCH)
-
-
-# This is the group that all of the installed files will be chgrp'ed to.
-RTGROUP = freeside
-
-
-# User which should own rt binaries.
-BIN_OWNER = root
-
-# User that should own all of RT's libraries, generally root.
-LIBS_OWNER = root
-
-# Group that should own all of RT's libraries, generally root.
-LIBS_GROUP = bin
-
-WEB_USER = freeside
-WEB_GROUP = freeside
-
-
-APACHECTL = /usr/sbin/apachectl
-
-
-# DESTDIR allows you to specify that RT be installed somewhere other than
-# where it will eventually reside. DESTDIR _must_ have a trailing slash
-# if it's defined.
-
-DESTDIR =
-
-
-
-RT_PATH = /opt/rt3
-RT_ETC_PATH = /opt/rt3/etc
-RT_BIN_PATH = /opt/rt3/bin
-RT_SBIN_PATH = /opt/rt3/sbin
-RT_LIB_PATH = /opt/rt3/lib
-RT_MAN_PATH = /opt/rt3/man
-RT_VAR_PATH = /opt/rt3/var
-RT_DOC_PATH = /opt/rt3/docs
-RT_FONT_PATH = /opt/rt3/share/fonts
-RT_LEXICON_PATH = /opt/rt3/share/po
-RT_LOCAL_PATH = /opt/rt3/local
-LOCAL_PLUGIN_PATH = /opt/rt3/local/plugins
-LOCAL_ETC_PATH = /opt/rt3/local/etc
-LOCAL_LIB_PATH = /opt/rt3/local/lib
-LOCAL_LEXICON_PATH = /opt/rt3/local/po
-MASON_HTML_PATH = /var/www/freeside/rt
-MASON_LOCAL_HTML_PATH = /opt/rt3/local/html
-MASON_DATA_PATH = /usr/local/etc/freeside/masondata
-MASON_SESSION_PATH = /opt/rt3/var/session_data
-RT_LOG_PATH = /opt/rt3/var/log
-
-# RT_READABLE_DIR_MODE is the mode of directories that are generally meant
-# to be accessable
-RT_READABLE_DIR_MODE = 0755
-
-
-
-
-
-# RT's CLI
-RT_CLI_BIN = rt
-# RT's mail gateway
-RT_MAILGATE_BIN = rt-mailgate
-# RT's cron tool
-RT_CRON_BIN = rt-crontool
-
-
-
-BINARIES = $(RT_MAILGATE_BIN) \
- $(RT_CLI_BIN) \
- $(RT_CRON_BIN)
-
-SYSTEM_BINARIES = rt-attributes-viewer \
- rt-clean-sessions \
- rt-dump-metadata \
- rt-email-dashboards \
- rt-email-digest \
- rt-email-group-admin \
- rt-fulltext-indexer \
- rt-preferences-viewer \
- rt-server \
- rt-session-viewer \
- rt-server.fcgi \
- rt-session-viewer \
- rt-setup-database \
- rt-setup-fulltext-index \
- rt-shredder \
- rt-test-dependencies \
- rt-validator \
- rt-validate-aliases \
- standalone_httpd
-
-
-ETC_FILES = acl.Pg \
- acl.Oracle \
- acl.mysql \
- schema.Pg \
- schema.Oracle \
- schema.mysql \
- schema.SQLite \
- initialdata
-
-
-
-WEB_HANDLER = modperl2
-
-
-
-#
-# DB_TYPE defines what sort of database RT trys to talk to
-# "mysql", "Oracle", "Pg", and "SQLite" are known to work.
-
-DB_TYPE = Pg
-
-# Set DBA to the name of a unix account with the proper permissions and
-# environment to run your commandline SQL sbin
-
-# Set DB_DBA to the name of a DB user with permission to create new databases
-
-# For mysql, you probably want 'root'
-# For Pg, you probably want 'postgres'
-# For Oracle, you want 'system'
-
-DB_DBA = freeside
-
-DB_HOST = localhost
-
-# If you're not running your database server on its default port,
-# specifiy the port the database server is running on below.
-# It's generally safe to leave this blank
-
-DB_PORT =
-
-
-
-
-#
-# Set this to the canonical name of the interface RT will be talking to the
-# database on. If you said that the RT_DB_HOST above was "localhost," this
-# should be too. This value will be used to grant rt access to the database.
-# If you want to access the RT database from multiple hosts, you'll need
-# to grant those database rights by hand.
-#
-
-DB_RT_HOST = localhost
-
-# set this to the name you want to give to the RT database in
-# your database server. For Oracle, this should be the name of your sid
-
-DB_DATABASE = freeside
-DB_RT_USER = freeside
-DB_RT_PASS =
-
-
-
-TEST_FILES = t/*.t t/*/*.t
-TEST_VERBOSE = 0
-
-RT_TEST_PARALLEL_NUM ?= 5
-
-
-####################################################################
-
-all: default
-
-default:
- @echo "Please read RT's README before beginning your installation."
-
-
-
-instruct:
- @echo "Congratulations. RT is now installed."
- @echo ""
- @echo ""
- @echo "You must now configure RT by editing $(SITE_CONFIG_FILE)."
- @echo ""
- @echo "(You will definitely need to set RT's database password in "
- @echo "$(SITE_CONFIG_FILE) before continuing. Not doing so could be "
- @echo "very dangerous. Note that you do not have to manually add a "
- @echo "database user or set up a database for RT. These actions will be "
- @echo "taken care of in the next step.)"
- @echo ""
- @echo "After that, you need to initialize RT's database by running"
- @echo " 'make initialize-database'"
-
-
-upgrade-instruct:
- @echo "Congratulations. RT has been upgraded. You should now check over"
- @echo "$(CONFIG_FILE) for any necessary site customization. Additionally,"
- @echo "you should update RT's system database objects by running "
- @echo " make upgrade-database"
-
-
-upgrade: testdeps config-install dirs files-install fixperms upgrade-instruct
-
-my_with_web_handlers= $(shell $(PERL) -e 'print join " ", map "--with-$$_", grep defined && length, split /,/, "$(WEB_HANDLER)"')
-testdeps:
- $(PERL) ./sbin/rt-test-dependencies --verbose --with-$(DB_TYPE) $(my_with_web_handlers)
-
-depends: fixdeps
-
-fixdeps:
- $(PERL) ./sbin/rt-test-dependencies --verbose --install --with-$(DB_TYPE) $(my_with_web_handlers)
-
-#}}}
-
-fixperms:
- # Make the libraries readable
- chmod $(RT_READABLE_DIR_MODE) $(DESTDIR)$(RT_PATH)
- chown -R $(LIBS_OWNER) $(DESTDIR)$(RT_LIB_PATH)
- chgrp -R $(LIBS_GROUP) $(DESTDIR)$(RT_LIB_PATH)
- chmod -R u+rwX,go-w,go+rX $(DESTDIR)$(RT_LIB_PATH)
-
-
- chmod $(RT_READABLE_DIR_MODE) $(DESTDIR)$(RT_BIN_PATH)
-
- chmod 0755 $(DESTDIR)$(RT_ETC_PATH)
- cd $(DESTDIR)$(RT_ETC_PATH) && chmod 0400 $(ETC_FILES) || true
-
- #TODO: the config file should probably be able to have its
- # owner set separately from the binaries.
- chown -R $(BIN_OWNER) $(DESTDIR)$(RT_ETC_PATH)
- chgrp -R $(RTGROUP) $(DESTDIR)$(RT_ETC_PATH)
-
- chmod 0440 $(DESTDIR)$(CONFIG_FILE)
- chmod 0640 $(DESTDIR)$(SITE_CONFIG_FILE)
- # Make this externally readable
- chmod 0440 $(DESTDIR)$(RT_ETC_PATH)/initialdata
-
- # Make the system binaries
- cd $(DESTDIR)$(RT_BIN_PATH) && ( chmod 0755 $(BINARIES) ; chown $(BIN_OWNER) $(BINARIES); chgrp $(RTGROUP) $(BINARIES))
-
- # Make the system binaries executable also
- cd $(DESTDIR)$(RT_SBIN_PATH) && ( chmod 0755 $(SYSTEM_BINARIES) ; chown $(BIN_OWNER) $(SYSTEM_BINARIES); chgrp $(RTGROUP) $(SYSTEM_BINARIES))
-
- # Make upgrade scripts executable if they are in the source.
- #
- # Note that we use the deprecated (by GNU/POSIX find) -perm +0NNN syntax
- # instead of -perm /0NNN since BSD find doesn't support the latter.
- ( cd etc/upgrade && find . -type f -not -name '*.in' -perm +0111 -print ) | while read file ; do \
- chmod a+x "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$file" ; \
- done
-
- # Make the web ui readable by all.
- chmod -R u+rwX,go-w,go+rX $(DESTDIR)$(MASON_HTML_PATH) \
- $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \
- $(DESTDIR)$(RT_LEXICON_PATH) \
- $(DESTDIR)$(LOCAL_LEXICON_PATH)
- chown -R $(LIBS_OWNER) $(DESTDIR)$(MASON_HTML_PATH) \
- $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \
- $(DESTDIR)$(RT_LEXICON_PATH) \
- $(DESTDIR)$(LOCAL_LEXICON_PATH)
- chgrp -R $(LIBS_GROUP) $(DESTDIR)$(MASON_HTML_PATH) \
- $(DESTDIR)$(MASON_LOCAL_HTML_PATH) \
- $(DESTDIR)$(RT_LEXICON_PATH) \
- $(DESTDIR)$(LOCAL_LEXICON_PATH)
-
- # Make the web ui's data dir writable
- chmod 0770 $(DESTDIR)$(MASON_DATA_PATH) \
- $(DESTDIR)$(MASON_SESSION_PATH)
- chown -R $(WEB_USER) $(DESTDIR)$(MASON_DATA_PATH) \
- $(DESTDIR)$(MASON_SESSION_PATH)
- chgrp -R $(WEB_GROUP) $(DESTDIR)$(MASON_DATA_PATH) \
- $(DESTDIR)$(MASON_SESSION_PATH)
-
-dirs:
- $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LOG_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_FONT_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LEXICON_PATH)
- $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)
- $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/cache
- $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/etc
- $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_DATA_PATH)/obj
- $(INSTALL) -m 0770 -d $(DESTDIR)$(MASON_SESSION_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_HTML_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_LOCAL_HTML_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_ETC_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_LIB_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_PLUGIN_PATH)
- $(INSTALL) -m 0755 -d $(DESTDIR)$(LOCAL_LEXICON_PATH)
-
-install: testdeps config-install dirs files-install fixperms instruct
-
-files-install: libs-install etc-install config-install bin-install sbin-install html-install doc-install font-install po-install
-
-config-install:
- $(INSTALL) -m 0755 -o $(BIN_OWNER) -g $(RTGROUP) -d $(DESTDIR)$(CONFIG_FILE_PATH)
- -$(INSTALL) -m 0440 -o $(BIN_OWNER) -g $(RTGROUP) etc/RT_Config.pm $(DESTDIR)$(CONFIG_FILE)
- [ -f $(DESTDIR)$(SITE_CONFIG_FILE) ] || $(INSTALL) -m 0640 -o $(BIN_OWNER) -g $(RTGROUP) etc/RT_SiteConfig.pm $(DESTDIR)$(SITE_CONFIG_FILE)
- @echo "Installed configuration. About to install RT in $(RT_PATH)"
-
-test:
- $(PERL) "-MExtUtils::Command::MM" -e "test_harness($(TEST_VERBOSE), 'lib')" $(TEST_FILES)
-
-parallel-test: test-parallel
-
-test-parallel:
- RT_TEST_PARALLEL=1 $(PERL) "-MApp::Prove" -e 'my $$p = App::Prove->new(); $$p->process_args("-wlrj$(RT_TEST_PARALLEL_NUM)","--state=slow,save", "t"); exit( $$p->run() ? 0 : 1 )'
-
-regression-reset-db: force-dropdb
- $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action init --dba-password ''
-
-initdb :: initialize-database
-
-initialize-database:
- $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action init --prompt-for-dba-password
-
-upgrade-database:
- $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action upgrade --prompt-for-dba-password
-
-dropdb:
- $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action drop --prompt-for-dba-password
-
-force-dropdb:
- $(PERL) -I$(LOCAL_LIB_PATH) -I$(RT_LIB_PATH) sbin/rt-setup-database --action drop --dba-password '' --force
-
-critic:
- perlcritic --quiet sbin bin lib
-
-libs-install:
- [ -d $(DESTDIR)$(RT_LIB_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LIB_PATH)
- -( cd lib && find . -type d -print ) | while read dir ; do \
- $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_LIB_PATH)/$$dir" ; \
- done
- -( cd lib && find . -type f -print ) | while read file ; do \
- $(INSTALL) -m 0644 "lib/$$file" "$(DESTDIR)$(RT_LIB_PATH)/$$file" ; \
- done
-
-html-install:
- [ -d $(DESTDIR)$(MASON_HTML_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(MASON_HTML_PATH)
- -( cd share/html && find . -type d -print ) | while read dir ; do \
- $(INSTALL) -m 0755 -d "$(DESTDIR)$(MASON_HTML_PATH)/$$dir" ; \
- done
- -( cd share/html && find . -type f -print ) | while read file ; do \
- $(INSTALL) -m 0644 "share/html/$$file" "$(DESTDIR)$(MASON_HTML_PATH)/$$file" ; \
- done
-
-font-install:
- [ -d $(DESTDIR)$(RT_FONT_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_FONT_PATH)
- -( cd share/fonts && find . -type f -print ) | while read file ; do \
- $(INSTALL) -m 0644 "share/fonts/$$file" "$(DESTDIR)$(RT_FONT_PATH)/$$file" ; \
- done
-
-
-po-install:
- [ -d $(DESTDIR)$(RT_LEXICON_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_LEXICON_PATH)
- -( cd share/po && find . -type f -print ) | while read file ; do \
- $(INSTALL) -m 0644 "share/po/$$file" "$(DESTDIR)$(RT_LEXICON_PATH)/$$file" ; \
- done
-
-
-
-doc-install:
- # RT 3.0.0 - RT 3.0.2 would accidentally create a file instead of a dir
- -[ -f $(DESTDIR)$(RT_DOC_PATH) ] && rm $(DESTDIR)$(RT_DOC_PATH)
- [ -d $(DESTDIR)$(RT_DOC_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_DOC_PATH)
- -( cd docs && find . -type d -print ) | while read dir ; do \
- $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_DOC_PATH)/$$dir" ; \
- done
- -( cd docs && find . -type f -print ) | while read file ; do \
- $(INSTALL) -m 0644 "docs/$$file" "$(DESTDIR)$(RT_DOC_PATH)/$$file" ; \
- done
- -$(INSTALL) -m 0644 ./README $(DESTDIR)$(RT_DOC_PATH)/
-
-
-etc-install:
- [ -d $(DESTDIR)$(RT_ETC_PATH) ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_ETC_PATH)
- for file in $(ETC_FILES) ; do \
- $(INSTALL) -m 0644 "etc/$$file" "$(DESTDIR)$(RT_ETC_PATH)/" ; \
- done
- [ -d $(DESTDIR)$(RT_ETC_PATH)/upgrade ] || $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_ETC_PATH)/upgrade
- -( cd etc/upgrade && find . -type d -print ) | while read dir ; do \
- $(INSTALL) -m 0755 -d "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$dir" ; \
- done
- -( cd etc/upgrade && find . -type f -not -name '*.in' -print ) | while read file ; do \
- $(INSTALL) -m 0644 "etc/upgrade/$$file" "$(DESTDIR)$(RT_ETC_PATH)/upgrade/$$file" ; \
- done
-
-
-sbin-install:
- $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_SBIN_PATH)
- for file in $(SYSTEM_BINARIES) ; do \
- $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "sbin/$$file" "$(DESTDIR)$(RT_SBIN_PATH)/" ; \
- done
-
-
-
-bin-install:
- $(INSTALL) -m 0755 -d $(DESTDIR)$(RT_BIN_PATH)
- for file in $(BINARIES) ; do \
- $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "bin/$$file" "$(DESTDIR)$(RT_BIN_PATH)/" ; \
- done
-
-
-
-regenerate-catalogs:
- $(PERL) devel/tools/extract-message-catalog
-
-license-tag:
- $(PERL) devel/tools/license_tag
-
-factory: initialize-database
- cd lib; $(PERL) ../devel/tools/factory $(DB_DATABASE) RT
-
-start-httpd:
- $(PERL) sbin/standalone_httpd &
-
-start-server:
- $(PERL) sbin/rt-server &
-
-apachectl:
- $(APACHECTL) stop
- sleep 10
- $(APACHECTL) start
- sleep 5
-
-SNAPSHOT=$(shell git describe --tags)
-THIRD_PARTY=devel/third-party/
-snapshot: build-snapshot build-third-party clearsign-snapshot clearsign-third-party snapshot-shasums
-
-build-snapshot:
- git archive --prefix "$(SNAPSHOT)/" HEAD | tar -xf -
- ( cd $(SNAPSHOT) && \
- echo "$(SNAPSHOT)" > .tag && \
- autoconf && \
- INSTALL=./install-sh PERL=/usr/bin/perl ./configure \
- --with-db-type=SQLite \
- --enable-layout=relative \
- --with-web-handler=standalone && \
- rm -rf autom4te.cache \
- config.status config.log config.pld \
- )
- tar -czf "$(SNAPSHOT).tar.gz" "$(SNAPSHOT)/"
- rm -fr "$(SNAPSHOT)/"
-
-clearsign-snapshot:
- gpg --no-armor --detach-sign "$(SNAPSHOT).tar.gz"
-
-build-third-party:
- git archive --prefix "$(SNAPSHOT)/$(THIRD_PARTY)" HEAD:$(THIRD_PARTY) \
- | gzip > "$(SNAPSHOT)-third-party-source.tar.gz"
- rm -rf "$(SNAPSHOT)/$(THIRD_PARTY)"
-
-clearsign-third-party:
- gpg --no-armor --detach-sign "$(SNAPSHOT)-third-party-source.tar.gz"
-
-snapshot-shasums:
- sha1sum $(SNAPSHOT)*.tar.gz*
-
-vessel-import: build-snapshot
- [ -d $(VESSEL) ] || (echo "VESSEL isn't a path to your shipwright vessel" && exit -1)
- cp $(VESSEL)/scripts/RT/build.pl /tmp/build.pl
- ./sbin/rt-test-dependencies --with-standalone --with-fastcgi --with-sqlite --list > /tmp/rt.yml
- shipwright import file:$(SNAPSHOT).tar.gz \
- --require-yml /tmp/rt.yml \
- --build-script /tmp/build.pl \
- --name RT \
- --repository fs:$(VESSEL) \
- --log-level=info \
- --skip cpan-capitalization,cpan-mod_perl,cpan-Encode,cpan-PPI,cpan-Test-Exception-LessClever,cpan-Test-Manifest,cpan-Test-Object,cpan-Test-Pod,cpan-Test-Requires,cpan-Test-SubCalls,cpan-Test-cpan-Tester,cpan-Test-Warn --skip-all-recommends
- mv $(VESSEL)/scripts/RT/build $(VESSEL)/scripts/RT/build.pl
-
-JSMIN_URL = http://download.bestpractical.com/mirror/jsmin-2011-01-22.c
-JSMIN_SHA = 8a6b3b980a52c028eb73aee4a82ebe060c1ee854
-
-jsmin: jsmin-checkcc jsmin-fetch jsmin-verify jsmin-confirm jsmin-build jsmin-install
- @echo ""
- @echo "To configure RT to use jsmin, add the following line to $(DESTDIR)$(RT_ETC_PATH)/RT_SiteConfig.pm:"
- @echo ""
- @echo " Set(\$$JSMinPath, '$(DESTDIR)$(RT_BIN_PATH)/jsmin');"
- @echo ""
-
-jsmin-checkcc:
- @[ -n "$(CC)" ] || (echo "You don't appear to have a C compiler, please set CC and re-run configure" && exit 1)
-
-jsmin-confirm:
- @echo "jsmin is distributed under a slightly unusual license and can't be shipped"
- @echo "with RT. Before configuring RT to use jsmin, please read jsmin's license"
- @echo "below:"
- @echo ""
- @$(PERL) -pe 'print && exit if /^\*\// or /^#include/' jsmin.c
- @echo ""
- @echo "Press Enter to accept the license, or Ctrl-C to stop now."
- @$(PERL) -e '<STDIN>'
-
-jsmin-fetch:
- @echo ""
- @echo "Downloading jsmin.c from $(JSMIN_URL)"
- @echo ""
- @$(PERL) -MLWP::Simple -e 'exit not is_success(getstore("$(JSMIN_URL)", "jsmin.c"))' \
- || (echo "Failed to download $(JSMIN_URL)" && exit 1)
-
-jsmin-verify:
- @$(PERL) -MDigest::SHA -e \
- 'exit not Digest::SHA->new(1)->addfile("jsmin.c")->hexdigest eq "$(JSMIN_SHA)"' \
- || (echo "Verification of jsmin.c failed! Possible man in the middle?" && exit 1)
-
-jsmin-build:
- $(CC) -o jsmin jsmin.c
-
-jsmin-install:
- $(INSTALL) -o $(BIN_OWNER) -g $(RTGROUP) -m 0755 "jsmin" "$(DESTDIR)$(RT_BIN_PATH)/"
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-use Carp;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT;
-
-use Getopt::Long;
-
-use RT::Interface::CLI qw(CleanEnv GetCurrentUser GetMessageContent loc);
-
-#Clean out all the nasties from the environment
-CleanEnv();
-
-my ( $search, $condition, $action, $search_arg, $condition_arg, $action_arg,
- $template, $template_id, $transaction, $transaction_type, $help, $log, $verbose );
-GetOptions(
- "search=s" => \$search,
- "search-arg=s" => \$search_arg,
- "condition=s" => \$condition,
- "condition-arg=s" => \$condition_arg,
- "action-arg=s" => \$action_arg,
- "action=s" => \$action,
- "template=s" => \$template,
- "template-id=s" => \$template_id,
- "transaction=s" => \$transaction,
- "transaction-type=s" => \$transaction_type,
- "log=s" => \$log,
- "verbose|v" => \$verbose,
- "help" => \$help,
-);
-
-# Load the config file
-RT::LoadConfig();
-
-# adjust logging to the screen according to options
-RT->Config->Set( LogToScreen => $log ) if $log;
-
-#Connect to the database and get RT::SystemUser and RT::Nobody loaded
-RT::Init();
-
-require RT::Tickets;
-require RT::Template;
-
-#Get the current user all loaded
-my $CurrentUser = GetCurrentUser();
-
-# show help even if there is no current user
-help() if $help;
-
-unless ( $CurrentUser->Id ) {
- print loc("No RT user found. Please consult your RT administrator.");
- exit(1);
-}
-
-help() unless $search && $action;
-
-$transaction = lc( $transaction||'' );
-if ( $transaction && $transaction !~ /^(first|all|last)$/i ) {
- print STDERR loc("--transaction argument could be only 'first', 'last' or 'all'");
- exit 1;
-}
-
-if ( $template && $template_id ) {
- print STDERR loc("--template-id is deprecated argument and can not be used with --template");
- exit 1;
-}
-elsif ( $template_id ) {
-# don't warn
- $template = $template_id;
-}
-
-# We _must_ have a search object
-load_module($search);
-load_module($action) if ($action);
-load_module($condition) if ($condition);
-
-my $void_scrip = RT::Scrip->new( $CurrentUser );
-my $void_scrip_action = RT::ScripAction->new( $CurrentUser );
-
-#At the appointed time:
-
-#find a bunch of tickets
-my $tickets = RT::Tickets->new($CurrentUser);
-$search = $search->new(
- TicketsObj => $tickets,
- Argument => $search_arg,
- CurrentUser => $CurrentUser
-);
-$search->Prepare();
-
-#for each ticket we've found
-while ( my $ticket = $tickets->Next() ) {
- print $ticket->Id() . ":\n" if ($verbose);
-
- my $template_obj = get_template( $ticket );
-
- if ( $transaction ) {
- my $txns = get_transactions($ticket);
- my $found = 0;
- while ( my $txn = $txns->Next ) {
- print "\t".loc("Using transaction #[_1]...", $txn->id)."\n"
- if $verbose;
- process($ticket, $txn, $template_obj);
- $found = 1;
- }
- print "\t".loc("Couldn't find suitable transaction, skipping")."\n"
- if $verbose && !$found;
- } else {
- print "\t".loc("Processing without transaction, some conditions and actions may fail. Consider using --transaction argument")."\n"
- if $verbose;
-
- process($ticket, undef, $template_obj);
- }
-}
-
-sub process {
- my $ticket = shift;
- my $transaction = shift;
- my $template_obj = shift;
-
- # perform some more advanced check
- if ($condition) {
- my $condition_obj = $condition->new(
- TransactionObj => $transaction,
- TicketObj => $ticket,
- ScripObj => $void_scrip,
- TemplateObj => $template_obj,
- Argument => $condition_arg,
- CurrentUser => $CurrentUser,
- );
-
- # if the condition doesn't apply, get out of here
-
- return unless $condition_obj->IsApplicable;
- print "\t".loc("Condition matches...")."\n" if $verbose;
- }
-
- #prepare our action
- my $action_obj = $action->new(
- TicketObj => $ticket,
- TransactionObj => $transaction,
- TemplateObj => $template_obj,
- Argument => $action_arg,
- ScripObj => $void_scrip,
- ScripActionObj => $void_scrip_action,
- CurrentUser => $CurrentUser,
- );
-
- #if our preparation, move onto the next ticket
- return unless $action_obj->Prepare;
- print "\t".loc("Action prepared...")."\n" if $verbose;
-
- #commit our action.
- return unless $action_obj->Commit;
- print "\t".loc("Action committed.")."\n" if $verbose;
-}
-
-# =head2 get_transactions
-#
-# Takes ticket and returns L<RT::Transactions> object with transactions
-# of the ticket according to command line arguments C<--transaction>
-# and <--transaction-type>.
-#
-# =cut
-
-sub get_transactions {
- my $ticket = shift;
- my $txns = $ticket->Transactions;
- my $order = $transaction eq 'last'? 'DESC': 'ASC';
- $txns->OrderByCols(
- { FIELD => 'Created', ORDER => $order },
- { FIELD => 'id', ORDER => $order },
- );
- if ( $transaction_type ) {
- $transaction_type =~ s/^\s+//;
- $transaction_type =~ s/\s+$//;
- foreach my $type ( split /\s*,\s*/, $transaction_type ) {
- $txns->Limit( FIELD => 'Type', VALUE => $type, ENTRYAGGREGATOR => 'OR' );
- }
- }
- $txns->RowsPerPage(1) unless $transaction eq 'all';
- return $txns;
-}
-
-# =head2 get_template
-#
-# Takes a ticket and returns a template according to command line options.
-#
-# =cut
-
-{ my $cache = undef;
-sub get_template {
- my $ticket = shift;
- return undef unless $template;
-
- unless ( $template =~ /\D/ ) {
- # by id
- return $cache if $cache;
-
- my $cache = RT::Template->new( RT->SystemUser );
- $cache->Load( $template );
- die "Failed to load template '$template'"
- unless $cache->id;
- return $cache;
- }
-
- my $queue = $ticket->Queue;
- return $cache->{ $queue } if $cache->{ $queue };
-
- my $res = RT::Template->new( RT->SystemUser );
- $res->LoadQueueTemplate( Queue => $queue, Name => $template );
- unless ( $res->id ) {
- $res->LoadGlobalTemplate( $template );
- die "Failed to load template '$template', either for queue #$queue or global"
- unless $res->id;
- }
- return $cache->{ $queue } = $res;
-} }
-
-
-# =head2 load_module
-#
-# Loads a perl module, dying nicely if it can't find it.
-#
-# =cut
-
-sub load_module {
- my $modname = shift;
- eval "require $modname";
- if ($@) {
- die loc( "Failed to load module [_1]. ([_2])", $modname, $@ );
- }
-
-}
-
-
-sub help {
-
- print loc( "[_1] is a tool to act on tickets from an external scheduling tool, such as cron.", $0 )
- . "\n";
- print loc("It takes several arguments:") . "\n\n";
-
- print " "
- . loc( "[_1] - Specify the search module you want to use", "--search" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--search-arg", "--search" )
- . "\n";
-
- print " "
- . loc( "[_1] - Specify the condition module you want to use", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--condition-arg", "--condition" )
- . "\n";
- print " "
- . loc( "[_1] - Specify the action module you want to use", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - An argument to pass to [_2]", "--action-arg", "--action" )
- . "\n";
- print " "
- . loc( "[_1] - Specify name or id of template(s) you want to use", "--template" )
- . "\n";
- print " "
- . loc( "[_1] - Specify if you want to use either 'first', 'last' or 'all' transactions", "--transaction" )
- . "\n";
- print " "
- . loc( "[_1] - Specify the comma separated list of transactions' types you want to use", "--transaction-type" )
- . "\n";
- print " "
- . loc( "[_1] - Adjust LogToScreen config option", "--log" ) . "\n";
- print " "
- . loc( "[_1] - Output status updates to STDOUT", "--verbose" ) . "\n";
- print "\n";
- print "\n";
- print loc("Security:")."\n";
- print loc("This tool allows the user to run arbitrary perl modules from within RT.")." ".
- loc("If this tool were setgid, a hostile local user could use this tool to gain administrative access to RT.")." ".
- loc("It is incredibly important that nonprivileged users not be allowed to run this tool."). " " .
- loc("It is suggested that you create a non-privileged unix user with the correct group membership and RT access to run this tool.")."\n";
- print "\n";
- print loc("Example:");
- print "\n";
- print " "
- . loc( "The following command will find all active tickets in the queue 'general' and set their priority to 99 if they are overdue:"
- )
- . "\n\n";
-
- print " bin/rt-crontool \\\n";
- print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
- print " --condition RT::Condition::Overdue \\\n";
- print " --action RT::Action::SetPriority --action-arg 99 \\\n";
- print " --verbose\n";
-
- print "\n";
- print loc("Escalate tickets"). "\n";
- print " bin/rt-crontool \\\n";
- print " --search RT::Search::ActiveTicketsInQueue --search-arg general \\\n";
- print" --action RT::Action::EscalatePriority\n";
-
-
-
-
-
-
- exit(0);
-}
-
-__END__
-
-=head1 NAME
-
-rt-crontool - a tool to act on tickets from an external scheduling tool
-
-=head1 SYNOPSIS
-
- # find all active tickets in the queue 'general' and set their priority to 99 if they are overdue:
- rt-crontool \
- --search RT::Search::ActiveTicketsInQueue --search-arg general \
- --condition RT::Condition::Overdue \
- --action RT::Action::SetPriority --action-arg 99 \
- --verbose
-
- # Escalate tickets
- rt-crontool \
- --search RT::Search::ActiveTicketsInQueue --search-arg general \
- --action RT::Action::EscalatePriority
-
-=head1 DESCRIPTION
-
-This script is a tool to act on tickets from an external scheduling tool, such
-as cron.
-
-Security:
-
-This tool allows the user to run arbitrary perl modules from within RT. If
-this tool were setgid, a hostile local user could use this tool to gain
-administrative access to RT. It is incredibly important that nonprivileged
-users not be allowed to run this tool. It is suggested that you create a
-non-privileged unix user with the correct group membership and RT access to
-run this tool.
-
-
-=head1 OPTIONS
-
-=over
-
-=item search
-
-Specify the search module you want to use
-
-=item search-arg
-
-An argument to pass to --search
-
-=item condition
-
-Specify the condition module you want to use
-
-=item condition-arg
-
-An argument to pass to --condition
-
-=item action
-
-Specify the action module you want to use
-
-=item action-arg
-
-An argument to pass to --action
-
-=item template
-
-Specify name or id of template(s) you want to use
-
-=item transaction
-
-Specify if you want to use either 'first', 'last' or 'all' transactions
-
-
-=item transaction-type
-
-Specify the comma separated list of transactions' types you want to use
-
-=item log
-
-Adjust LogToScreen config option
-
-=item verbose
-
-Output status updates to STDOUT
-
-=back
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-=head1 NAME
-
-rt-mailgate - Mail interface to RT.
-
-=cut
-
-use strict;
-use warnings;
-
-use Getopt::Long;
-
-my $opts = { };
-GetOptions( $opts, "queue=s", "action=s", "url=s",
- "jar=s", "help", "debug", "extension=s",
- "timeout=i", "verify-ssl!", "ca-file=s",
- );
-
-my $gateway = RT::Client::MailGateway->new();
-
-$gateway->run($opts);
-
-package RT::Client::MailGateway;
-
-use LWP::UserAgent;
-use HTTP::Request::Common qw($DYNAMIC_FILE_UPLOAD);
-use File::Temp qw(tempfile tempdir);
-$DYNAMIC_FILE_UPLOAD = 1;
-
-use constant EX_TEMPFAIL => 75;
-use constant BUFFER_SIZE => 8192;
-
-sub new {
- my $class = shift;
- my $self = bless {}, $class;
- return $self;
-}
-
-sub run {
- my $self = shift;
- my $opts = shift;
-
- if ( $opts->{running_in_test_harness} ) {
- $self->{running_in_test_harness} = 1;
- }
-
- $self->validate_cli_flags($opts);
-
- my $ua = $self->get_useragent($opts);
- my $post_params = $self->setup_session($opts);
- $self->upload_message( $ua => $post_params );
- $self->exit_with_success();
-}
-
-sub exit_with_success {
- my $self = shift;
- if ( $self->{running_in_test_harness} ) {
- return 1;
- } else {
- exit 0;
- }
-}
-
-sub tempfail {
- my $self = shift;
- if ( $self->{running_in_test_harness} ) {
- die "tempfail";
- } else {
-
- exit EX_TEMPFAIL;
- }
-}
-
-sub permfail {
- my $self = shift;
- if ( $self->{running_in_test_harness} ) {
- die "permfail";
- } else {
-
- exit 1;
- }
-}
-
-sub validate_cli_flags {
- my $self = shift;
- my $opts = shift;
- if ( $opts->{'help'} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage( { verbose => 2 } );
- return $self->permfail()
- ; # Don't want to succeed if this is really an email!
- }
-
- unless ( $opts->{'url'} ) {
- print STDERR
- "$0 invoked improperly\n\nNo 'url' provided to mail gateway!\n";
- return $self->permfail();
- }
-
- if (($opts->{'ca-file'} or $opts->{"verify-ssl"})
- and not LWP::UserAgent->can("ssl_opts")) {
- print STDERR "Verifying SSL certificates requires LWP::UserAgent 6.0 or higher.\n";
- return $self->tempfail();
- }
-
- $opts->{"verify-ssl"} = 1 unless defined $opts->{"verify-ssl"};
-}
-
-sub get_useragent {
- my $self = shift;
- my $opts = shift;
- my $ua = LWP::UserAgent->new();
- $ua->cookie_jar( { file => $opts->{'jar'} } ) if $opts->{'jar'};
-
- if ( $ua->can("ssl_opts") ) {
- $ua->ssl_opts( verify_hostname => $opts->{'verify-ssl'} );
- $ua->ssl_opts( SSL_ca_file => $opts->{'ca-file'} )
- if $opts->{'ca-file'};
- }
-
- return $ua;
-}
-
-sub setup_session {
- my $self = shift;
- my $opts = shift;
- my %post_params;
- foreach (qw(queue action)) {
- $post_params{$_} = $opts->{$_} if defined $opts->{$_};
- }
-
- if ( ( $opts->{'extension'} || '' ) =~ /^(?:action|queue|ticket)$/i ) {
- $post_params{ lc $opts->{'extension'} } = $ENV{'EXTENSION'}
- || $opts->{ $opts->{'extension'} };
- } elsif ( $opts->{'extension'} && $ENV{'EXTENSION'} ) {
- print STDERR
- "Value of the --extension argument is not action, queue or ticket"
- . ", but environment variable EXTENSION is also defined. The former is ignored.\n";
- }
-
- # add ENV{'EXTENSION'} as X-RT-MailExtension to the message header
- if ( my $value = ( $ENV{'EXTENSION'} || $opts->{'extension'} ) ) {
-
- # prepare value to avoid MIME format breakage
- # strip trailing newline symbols
- $value =~ s/(\r*\n)+$//;
-
- # make a correct multiline header field,
- # with tabs in the beginning of each line
- $value =~ s/(\r*\n)/$1\t/g;
- $opts->{'headers'} .= "X-RT-Mail-Extension: $value\n";
- }
-
- # Read the message in from STDIN
- # _raw_message is used for testing
- my $message = $opts->{'_raw_message'} || $self->slurp_message();
- unless ( $message->{'filename'} ) {
- $post_params{'message'} = [
- undef, '',
- 'Content-Type' => 'application/octet-stream',
- Content => ${ $message->{'content'} },
- ];
- } else {
- $post_params{'message'} = [
- $message->{'filename'}, '',
- 'Content-Type' => 'application/octet-stream',
- ];
- }
-
- return \%post_params;
-}
-
-sub upload_message {
- my $self = shift;
- my $ua = shift;
- my $post_params = shift;
- my $full_url = $opts->{'url'} . "/REST/1.0/NoAuth/mail-gateway";
- print STDERR "$0: connecting to $full_url\n" if $opts->{'debug'};
-
- $ua->timeout( exists( $opts->{'timeout'} ) ? $opts->{'timeout'} : 180 );
- my $r = $ua->post( $full_url, $post_params, Content_Type => 'form-data' );
- $self->check_failure($r);
-
- my $content = $r->content;
- print STDERR $content . "\n" if $opts->{'debug'};
-
- return if ( $content =~ /^(ok|not ok)/ );
-
- # It's not the server's fault if the mail is bogus. We just want to know that
- # *something* came out of the server.
- print STDERR <<EOF;
-RT server error.
-
-The RT server which handled your email did not behave as expected. It
-said:
-
-$content
-EOF
-
- return $self->tempfail();
-}
-
-sub check_failure {
- my $self = shift;
- my $r = shift;
- return if $r->is_success;
-
- # XXX TODO 4.2: Remove the multi-line error strings in favor of something more concise
- print STDERR <<" ERROR";
-An Error Occurred
-=================
-
-@{[ $r->status_line ]}
- ERROR
- print STDERR "\n$0: undefined server error\n" if $opts->{'debug'};
- return $self->tempfail();
-}
-
-sub slurp_message {
- my $self = shift;
-
- local $@;
-
- my %message;
- my ( $fh, $filename )
- = eval { tempfile( DIR => tempdir( CLEANUP => 1 ) ) };
- if ( !$fh || $@ ) {
- print STDERR "$0: Couldn't create temp file, using memory\n";
- print STDERR "error: $@\n" if $@;
-
- my $message = \do { local ( @ARGV, $/ ); <STDIN> };
- unless ( $$message =~ /\S/ ) {
- print STDERR "$0: no message passed on STDIN\n";
- $self->exit_with_success;
- }
- $$message = $opts->{'headers'} . $$message if $opts->{'headers'};
- return ( { content => $message } );
- }
-
- binmode $fh;
- binmode \*STDIN;
-
- print $fh $opts->{'headers'} if $opts->{'headers'};
-
- my $buf;
- my $empty = 1;
- while (1) {
- my $status = read \*STDIN, $buf, BUFFER_SIZE;
- unless ( defined $status ) {
- print STDERR "$0: couldn't read message: $!\n";
- return $self->tempfail();
- } elsif ( !$status ) {
- last;
- }
- $empty = 0 if $buf =~ /\S/;
- print $fh $buf;
- }
- close $fh;
-
- if ($empty) {
- print STDERR "$0: no message passed on STDIN\n";
- $self->exit_with_success;
- }
- print STDERR "$0: temp file is '$filename'\n" if $opts->{'debug'};
- return ( { filename => $filename } );
-}
-
-=head1 SYNOPSIS
-
- rt-mailgate --help : this text
-
-Usual invocation (from MTA):
-
- rt-mailgate --action (correspond|comment|...) --queue queuename
- --url http://your.rt.server/
- [ --debug ]
- [ --extension (queue|action|ticket) ]
- [ --timeout seconds ]
-
-
-
-=head1 OPTIONS
-
-=over 3
-
-=item C<--action>
-
-Specifies what happens to email sent to this alias. The avaliable
-basic actions are: C<correspond>, C<comment>.
-
-
-If you've set the RT configuration variable B<< C<UnsafeEmailCommands> >>,
-C<take> and C<resolve> are also available. You can execute two or more
-actions on a single message using a C<-> separated list. RT will execute
-the actions in the listed order. For example you can use C<take-comment>,
-C<correspond-resolve> or C<take-comment-resolve> as actions.
-
-Note that C<take> and C<resolve> actions ignore message text if used
-alone. Include a C<comment> or C<correspond> action if you want RT
-to record the incoming message.
-
-The default action is C<correspond>.
-
-=item C<--queue>
-
-This flag determines which queue this alias should create a ticket in if no ticket identifier
-is found.
-
-=item C<--url>
-
-This flag tells the mail gateway where it can find your RT server. You should
-probably use the same URL that users use to log into RT.
-
-If your RT server uses SSL, you will need to install additional Perl
-libraries. RT will detect and install these dependencies if you pass the
-C<--enable-ssl-mailgate> flag to configure as documented in RT's README.
-
-If you have a self-signed SSL certificate, you may also need to pass
-C<--ca-file> or C<--no-verify-ssl>, below.
-
-=item C<--ca-file> I<path>
-
-Specifies the path to the public SSL certificate for the certificate
-authority that should be used to verify the website's SSL certificate.
-If your webserver uses a self-signed certificate, you should
-preferentially use this option over C<--no-verify-ssl>, as it will
-ensure that the self-signed certificate that the mailgate is seeing the
-I<right> self-signed certificate.
-
-=item C<--no-verify-ssl>
-
-This flag tells the mail gateway to trust all SSL certificates,
-regardless of if their hostname matches the certificate, and regardless
-of CA. This is required if you have a self-signed certificate, or some
-other certificate which is not traceable back to an certificate your
-system ultimitely trusts.
-
-Verifying SSL certificates requires L<LWP::UserAgent> version 6.0 or
-higher; explicitly passing C<--verify-ssl> on prior versions will error.
-
-=item C<--extension> OPTIONAL
-
-Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
-and present "foo" in the environment variable $EXTENSION. By specifying
-the value "queue" for this parameter, the queue this message should be
-submitted to will be set to the value of $EXTENSION. By specifying
-"ticket", $EXTENSION will be interpreted as the id of the ticket this message
-is related to. "action" will allow the user to specify either "comment" or
-"correspond" in the address extension.
-
-=item C<--debug> OPTIONAL
-
-Print debugging output to standard error
-
-
-=item C<--timeout> OPTIONAL
-
-Configure the timeout for posting the message to the web server. The
-default timeout is 3 minutes (180 seconds).
-
-=back
-
-
-=head1 DESCRIPTION
-
-The RT mail gateway is the primary mechanism for communicating with RT
-via email. This program simply directs the email to the RT web server,
-which handles filing correspondence and sending out any required mail.
-It is designed to be run as part of the mail delivery process, either
-called directly by the MTA or C<procmail>, or in a F<.forward> or
-equivalent.
-
-=head1 SETUP
-
-Much of the set up of the mail gateway depends on your MTA and mail
-routing configuration. However, you will need first of all to create an
-RT user for the mail gateway and assign it a password; this helps to
-ensure that mail coming into the web server did originate from the
-gateway.
-
-Next, you need to route mail to C<rt-mailgate> for the queues you're
-monitoring. For instance, if you're using F</etc/aliases> and you have a
-"bugs" queue, you will want something like this:
-
- bugs: "|/opt/rt4/bin/rt-mailgate --queue bugs --action correspond
- --url http://rt.mycorp.com/"
-
- bugs-comment: "|/opt/rt4/bin/rt-mailgate --queue bugs --action comment
- --url http://rt.mycorp.com/"
-
-Note that you don't have to run your RT server on your mail server, as
-the mail gateway will happily relay to a different machine.
-
-=head1 CUSTOMIZATION
-
-By default, the mail gateway will accept mail from anyone. However,
-there are situations in which you will want to authenticate users
-before allowing them to communicate with the system. You can do this
-via a plug-in mechanism in the RT configuration.
-
-You can set the array C<@MailPlugins> to be a list of plugins. The
-default plugin, if this is not given, is C<Auth::MailFrom> - that is,
-authentication of the person is done based on the C<From> header of the
-email. If you have additional filters or authentication mechanisms, you
-can list them here and they will be called in order:
-
- Set( @MailPlugins =>
- "Filter::SpamAssassin",
- "Auth::LDAP",
- # ...
- );
-
-See the documentation for any additional plugins you have.
-
-You may also put Perl subroutines into the C<@MailPlugins> array, if
-they behave as described below.
-
-=head1 WRITING PLUGINS
-
-What's actually going on in the above is that C<@MailPlugins> is a
-list of Perl modules; RT prepends C<RT::Interface::Email::> to the name,
-to form a package name, and then C<use>'s this module. The module is
-expected to provide a C<GetCurrentUser> subroutine, which takes a hash of
-several parameters:
-
-=over 4
-
-=item Message
-
-A C<MIME::Entity> object representing the email
-
-=item CurrentUser
-
-An C<RT::CurrentUser> object
-
-=item AuthStat
-
-The authentication level returned from the previous plugin.
-
-=item Ticket [OPTIONAL]
-
-The ticket under discussion
-
-=item Queue [OPTIONAL]
-
-If we don't already have a ticket id, we need to know which queue we're talking about
-
-=item Action
-
-The action being performed. At the moment, it's one of "comment" or "correspond"
-
-=back
-
-It returns two values, the new C<RT::CurrentUser> object, and the new
-authentication level. The authentication level can be zero, not allowed
-to communicate with RT at all, (a "permission denied" error is mailed to
-the correspondent) or one, which is the normal mode of operation.
-Additionally, if C<-1> is returned, then the processing of the plug-ins
-stops immediately and the message is ignored.
-
-=head1 ENVIRONMENT
-
-=over 4
-
-=item EXTENSION
-
-Some MTAs will route mail sent to user-foo@host or user+foo@host to user@host
-and present "foo" in the environment variable C<EXTENSION>. Mailgate adds value
-of this variable to message in the C<X-RT-Mail-Extension> field of the message
-header.
-
-See also C<--extension> option. Note that value of the environment variable is
-always added to the message header when it's not empty even if C<--extension>
-option is not provided.
-
-=back
-
-=cut
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-local $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
-local $ENV{'CDPATH'} = '' if defined $ENV{'CDPATH'};
-local $ENV{'SHELL'} = '/bin/sh' if defined $ENV{'SHELL'};
-local $ENV{'ENV'} = '' if defined $ENV{'ENV'};
-local $ENV{'IFS'} = '' if defined $ENV{'IFS'};
-
-package HTML::Mason::Commands;
-our %session;
-
-package RT::Mason;
-
-our ($Nobody, $SystemUser, $Handler, $r);
-
-my $protect_fd;
-
-sub handler {
- ($r) = @_;
-
- if ( !$protect_fd && $ENV{'MOD_PERL'} && exists $ENV{'MOD_PERL_API_VERSION'}
- && $ENV{'MOD_PERL_API_VERSION'} >= 2 && fileno(STDOUT) != 1
- ) {
- # under mod_perl2, STDOUT gets closed and re-opened, however new STDOUT
- # is not on FD #1. In this case next IO operation will occupy this FD
- # and make all system() and open "|-" dangerouse, for example DBI
- # can get this FD for DB connection and system() call will close
- # by putting grabage into the socket
- open( $protect_fd, '>', '/dev/null' )
- or die "Couldn't open /dev/null: $!";
- unless ( fileno($protect_fd) == 1 ) {
- warn "We opened /dev/null to protect FD #1, but descriptor #1 is already occupied";
- }
- }
-
- local $SIG{__WARN__};
- local $SIG{__DIE__};
- RT::InitSignalHandlers();
-
- if ($r->content_type =~ m/^httpd\b.*\bdirectory/i) {
- use File::Spec::Unix;
- # Our DirectoryIndex is always index.html, regardless of httpd settings
- $r->filename( File::Spec::Unix->catfile( $r->filename, 'index.html' ) );
- }
-
- Module::Refresh->refresh if RT->Config->Get('DevelMode');
-
- RT::ConnectToDatabase();
-
- # none of the methods in $r gives us the information we want (most
- # canonicalize /foo/../bar to /bar which is exactly what we want to avoid)
- my (undef, $requested) = split ' ', $r->the_request, 3;
- my $uri = URI->new("http://".$r->hostname.$requested);
- my $path = URI::Escape::uri_unescape($uri->path);
-
- ## Each environment has its own way of handling .. and so on in paths,
- ## so RT consistently forbids such paths.
- if ( $path =~ m{/\.} ) {
- $RT::Logger->crit("Invalid request for ".$path." aborting");
- RT::Interface::Web::Handler->CleanupRequest();
- return 400;
- }
-
- my (%session, $status);
- {
- local $@;
- $status = eval { $Handler->handle_request($r) };
- $RT::Logger->crit( $@ ) if $@;
- }
- undef %session;
-
- RT::Interface::Web::Handler->CleanupRequest();
-
- return $status;
-}
-
-package main;
-
-# check mod_perl version if it's mod_perl
-BEGIN {
- die "RT does not support mod_perl 1.99. Please upgrade to mod_perl 2.0"
- if $ENV{'MOD_PERL'}
- and $ENV{'MOD_PERL'} =~ m{mod_perl/(?:1\.9)};
-}
-
-require CGI;
-CGI->import(qw(-private_tempfiles));
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-require RT;
-die "Wrong version of RT $RT::Version found; need 3.8.*"
- unless $RT::VERSION =~ /^3\.8\./;
-RT::LoadConfig();
-if ( RT->Config->Get('DevelMode') ) {
- require Module::Refresh;
-}
-RT::Init();
-
-# check compatibility of the DB
-{
- my $dbh = $RT::Handle->dbh;
- if ( $dbh ) {
- my ($status, $msg) = $RT::Handle->CheckCompatibility( $dbh, 'post' );
- die $msg unless $status;
- }
-}
-
-require RT::Interface::Web::Handler;
-$RT::Mason::Handler = RT::Interface::Web::Handler->new(
- RT->Config->Get('MasonParameters')
-);
-
-# load more for mod_perl before forking
-RT::InitClasses( Heavy => 1 ) if $ENV{'MOD_PERL'} || $ENV{RT_WEBMUX_HEAVY_LOAD};
-
-# we must disconnect DB before fork
-$RT::Handle->dbh(undef);
-undef $RT::Handle;
-
-if ( $ENV{'MOD_PERL'} && !RT->Config->Get('DevelMode')) {
- # Under static_source, we need to purge the component cache
- # each time we restart, so newer components may be reloaded.
- #
- # We can't do this in FastCGI or we'll blow away the component
- # root _every_ time a new server starts which happens every few
- # hits.
-
- require File::Path;
- require File::Glob;
- my @files = File::Glob::bsd_glob("$RT::MasonDataDir/obj/*");
- File::Path::rmtree([ @files ], 0, 1) if @files;
-}
-
-1;
+++ /dev/null
-##
-## config.layout -- Pre-defined Installation Path Layouts
-##
-## Hints:
-## - layouts can be loaded with configure's --enable-layout=ID option
-## - when no --enable-layout option is given, the default layout is `RT'
-## - a trailing plus character (`+') on paths is replaced with a
-## `/<target>' suffix where <target> is currently hardcoded to 'rt3'.
-## (This may become a configurable parameter at some point.)
-##
-## The following variables must _all_ be set:
-## prefix exec_prefix bindir sbindir sysconfdir mandir libdir
-## datadir htmldir localstatedir logfiledir masonstatedir fontdir
-## sessionstatedir customdir customhtmldir customlexdir
-## (This can be seen in m4/rt_layout.m4.)
-##
-
-# Default RT3 path layout.
-<Layout RT3>
- prefix: /opt/rt4
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: ${prefix}/etc
- mandir: ${prefix}/man
- plugindir: ${prefix}/plugins
- libdir: ${prefix}/lib
- datadir: ${prefix}/share
- htmldir: ${datadir}/html
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: ${prefix}/docs
- localstatedir: ${prefix}/var
- logfiledir: ${localstatedir}/log
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: ${prefix}/local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-<Layout inplace>
- prefix: .
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: ${prefix}/etc
- mandir: ${prefix}/man
- plugindir: ${prefix}/plugins
- libdir: ${prefix}/lib
- datadir: ${prefix}/share
- htmldir: ${datadir}/html
- lexdir: ${datadir}/po
- fontdir: ${datadir}/fonts
- manualdir: ${prefix}/docs
- localstatedir: ${prefix}/var
- logfiledir: ${localstatedir}/log
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: ${prefix}/local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
-<Layout FHS>
- prefix: /usr/local
- exec_prefix: ${prefix}
- bindir: ${prefix}/bin
- sbindir: ${prefix}/sbin
- sysconfdir: /etc+
- datadir: ${prefix}/share
-# FIXME: missing support for lib64
- libdir: ${prefix}/lib
- mandir: ${datadir}/man
-# FIXME: no such directory in FHS; shouldn't go to somewhere in "${datadir}/rt/"?
- plugindir: ${datadir}/plugins
- htmldir: ${datadir}/html
- lexdir: ${datadir}/po
- fontdir: ${datadir}/fonts
- manualdir: ${datadir}/doc
- localstatedir: /var
- logfiledir: ${localstatedir}/log
-# XXX: "/var/cache/mason/*"?
- masonstatedir: ${localstatedir}/cache/mason_data
- sessionstatedir: ${localstatedir}/cache/session_data
- customdir: ${prefix}/local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
-<Layout FreeBSD>
- prefix: /usr/local
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: ${prefix}/etc+
- mandir: ${prefix}/man
- plugindir: ${prefix}/plugins
- libdir: ${prefix}/lib+
- datadir: ${prefix}/share+
- htmldir: ${datadir}/html
- lexdir: ${datadir}/po
- fontdir: ${datadir}/fonts
- manualdir: ${prefix}/share/doc+
- logfiledir: /var/log
- localstatedir: /var/run+
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: ${prefix}/share+
- custometcdir: ${customdir}/local/etc
- customhtmldir: ${customdir}/local/html
- customlexdir: ${customdir}/local/po
- customlibdir: ${customdir}/local/lib
- customplugindir: ${customdir}/local/plugins
-</Layout>
-
-<Layout Win32>
- prefix: C:/Program Files/Request Tracker
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: ${prefix}/etc
- mandir: ${prefix}/man
- plugindir: ${prefix}/plugins
- libdir: ${prefix}/lib
- datadir: ${prefix}
- htmldir: ${datadir}/html
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: ${datadir}/doc
- localstatedir: ${prefix}/var
- logfiledir: ${localstatedir}/log
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: ${prefix}/local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
-# RH path layout.
-<Layout RH>
- prefix: /usr
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: /etc/rt3
- mandir: ${prefix}/man
- libdir: ${prefix}/lib/rt3
- datadir: /var/rt3
- htmldir: ${datadir}/html
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: ${datadir}/doc
- plugindir: ${datadir}/plugins
- localstatedir: /var
- logfiledir: ${localstatedir}/log/rt3
- masonstatedir: ${localstatedir}/rt3/mason_data
- sessionstatedir: ${localstatedir}/rt3/session_data
- customdir: ${prefix}/local/rt3
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
-
-<Layout relative>
- prefix: /opt/rt4
- exec_prefix: ${prefix}
- bindir: bin
- sbindir: sbin
- sysconfdir: etc
- mandir: man
- plugindir: plugins
- libdir: lib
- datadir: share
- htmldir: ${datadir}/html
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: docs
- localstatedir: var
- logfiledir: ${localstatedir}/log
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-<Layout vessel>
- prefix: /opt/rt4
- exec_prefix: ${prefix}
- bindir: bin
- sbindir: sbin
- sysconfdir: etc/rt/
- mandir: man
- libdir: lib/rt
- datadir: share/rt
- plugindir: ${datadir}/plugins
- htmldir: ${datadir}/html
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: docs/rt
- localstatedir: var/rt/
- logfiledir: ${localstatedir}/log
- masonstatedir: ${localstatedir}/mason_data
- sessionstatedir: ${localstatedir}/session_data
- customdir: local/rt/
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
-<Layout Freeside>
- prefix: /opt/rt3
- exec_prefix: ${prefix}
- bindir: ${exec_prefix}/bin
- sbindir: ${exec_prefix}/sbin
- sysconfdir: ${prefix}/etc
- mandir: ${prefix}/man
- plugindir: ${prefix}/plugins
- libdir: ${prefix}/lib
- datadir: ${prefix}/share
- htmldir: /var/www/freeside/rt
- fontdir: ${datadir}/fonts
- lexdir: ${datadir}/po
- manualdir: ${prefix}/docs
- localstatedir: ${prefix}/var
- logfiledir: ${localstatedir}/log
- masonstatedir: /usr/local/etc/freeside/masondata
- sessionstatedir: ${localstatedir}/session_data
- customdir: ${prefix}/local
- custometcdir: ${customdir}/etc
- customhtmldir: ${customdir}/html
- customlexdir: ${customdir}/po
- customlibdir: ${customdir}/lib
- customplugindir: ${customdir}/plugins
-</Layout>
-
+++ /dev/null
-This file contains any messages produced by compilers while
-running configure, to aid debugging if configure makes a mistake.
-
-It was created by RT configure rt-4.0.21, which was
-generated by GNU Autoconf 2.68. Invocation command line was
-
- $ ./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2
-
-## --------- ##
-## Platform. ##
-## --------- ##
-
-hostname = fleetpaw
-uname -m = x86_64
-uname -r = 3.14-2-amd64
-uname -s = Linux
-uname -v = #1 SMP Debian 3.14.15-2 (2014-08-09)
-
-/usr/bin/uname -p = unknown
-/bin/uname -X = unknown
-
-/bin/arch = unknown
-/usr/bin/arch -k = unknown
-/usr/convex/getsysinfo = unknown
-/usr/bin/hostinfo = unknown
-/bin/machine = unknown
-/usr/bin/oslevel = unknown
-/bin/universe = unknown
-
-PATH: /usr/local/sbin
-PATH: /usr/local/bin
-PATH: /usr/sbin
-PATH: /usr/bin
-PATH: /sbin
-PATH: /bin
-
-
-## ----------- ##
-## Core tests. ##
-## ----------- ##
-
-configure:1903: checking for a BSD-compatible install
-configure:1971: result: /usr/bin/install -c
-configure:1985: checking for perl
-configure:2003: found /usr/bin/perl
-configure:2016: result: /usr/bin/perl
-configure:2394: checking for chosen layout
-configure:2407: result: Freeside
-configure:2641: checking if database name is set
-configure:2644: result: yes
-configure:2700: checking for dot
-configure:2716: found /usr/bin/dot
-configure:2728: result: yes
-configure:2756: checking for gdlib-config
-configure:2784: result: no
-configure:2812: checking for gpg
-configure:2828: found /usr/bin/gpg
-configure:2840: result: yes
-configure:3185: creating ./config.status
-
-## ---------------------- ##
-## Running config.status. ##
-## ---------------------- ##
-
-This file was extended by RT config.status rt-4.0.21, which was
-generated by GNU Autoconf 2.68. Invocation command line was
-
- CONFIG_FILES =
- CONFIG_HEADERS =
- CONFIG_LINKS =
- CONFIG_COMMANDS =
- $ ./config.status
-
-on fleetpaw
-
-config.status:872: creating etc/upgrade/3.8-ical-extension
-config.status:872: creating etc/upgrade/4.0-customfield-checkbox-extension
-config.status:872: creating etc/upgrade/split-out-cf-categories
-config.status:872: creating etc/upgrade/generate-rtaddressregexp
-config.status:872: creating etc/upgrade/upgrade-articles
-config.status:872: creating etc/upgrade/vulnerable-passwords
-config.status:872: creating sbin/rt-attributes-viewer
-config.status:872: creating sbin/rt-preferences-viewer
-config.status:872: creating sbin/rt-session-viewer
-config.status:872: creating sbin/rt-dump-metadata
-config.status:872: creating sbin/rt-setup-database
-config.status:872: creating sbin/rt-test-dependencies
-config.status:872: creating sbin/rt-email-digest
-config.status:872: creating sbin/rt-email-dashboards
-config.status:872: creating sbin/rt-clean-sessions
-config.status:872: creating sbin/rt-shredder
-config.status:872: creating sbin/rt-validator
-config.status:872: creating sbin/rt-validate-aliases
-config.status:872: creating sbin/rt-email-group-admin
-config.status:872: creating sbin/rt-server
-config.status:872: creating sbin/rt-server.fcgi
-config.status:872: creating sbin/standalone_httpd
-config.status:872: creating sbin/rt-setup-fulltext-index
-config.status:872: creating sbin/rt-fulltext-indexer
-config.status:872: creating bin/rt-crontool
-config.status:872: creating bin/rt-mailgate
-config.status:872: creating bin/rt
-config.status:872: creating Makefile
-config.status:872: creating etc/RT_Config.pm
-config.status:872: creating lib/RT/Generated.pm
-config.status:872: creating t/data/configs/apache2.2+mod_perl.conf
-config.status:872: creating t/data/configs/apache2.2+fastcgi.conf
-
-## ---------------- ##
-## Cache variables. ##
-## ---------------- ##
-
-ac_cv_env_PERL_set=
-ac_cv_env_PERL_value=
-ac_cv_env_build_alias_set=
-ac_cv_env_build_alias_value=
-ac_cv_env_host_alias_set=
-ac_cv_env_host_alias_value=
-ac_cv_env_target_alias_set=
-ac_cv_env_target_alias_value=
-ac_cv_path_PERL=/usr/bin/perl
-ac_cv_path_install='/usr/bin/install -c'
-ac_cv_prog_RT_GD=no
-ac_cv_prog_RT_GPG=yes
-ac_cv_prog_RT_GRAPHVIZ=yes
-
-## ----------------- ##
-## Output variables. ##
-## ----------------- ##
-
-APACHECTL='/usr/sbin/apachectl'
-BIN_OWNER='root'
-COMMENT_INPLACE_LAYOUT=''
-CONFIGURE_INCANT='./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2'
-CONFIG_FILE_PATH='/opt/rt3/etc'
-CONFIG_FILE_PATH_R='/opt/rt3/etc'
-DATABASE_ENV_PREF=''
-DB_DATABASE='freeside'
-DB_DBA='freeside'
-DB_HOST='localhost'
-DB_PORT=''
-DB_RT_HOST='localhost'
-DB_RT_PASS=''
-DB_RT_USER='freeside'
-DB_TYPE='Pg'
-DEFS='-DPACKAGE_NAME=\"RT\" -DPACKAGE_TARNAME=\"rt\" -DPACKAGE_VERSION=\"rt-4.0.21\" -DPACKAGE_STRING=\"RT\ rt-4.0.21\" -DPACKAGE_BUGREPORT=\"rt-bugs@bestpractical.com\" -DPACKAGE_URL=\"\"'
-ECHO_C=''
-ECHO_N='-n'
-ECHO_T=''
-INSTALL_DATA='${INSTALL} -m 644'
-INSTALL_PROGRAM='${INSTALL}'
-INSTALL_SCRIPT='${INSTALL}'
-LIBOBJS=''
-LIBS=''
-LIBS_GROUP='bin'
-LIBS_OWNER='root'
-LOCAL_ETC_PATH='/opt/rt3/local/etc'
-LOCAL_ETC_PATH_R='/opt/rt3/local/etc'
-LOCAL_LEXICON_PATH='/opt/rt3/local/po'
-LOCAL_LEXICON_PATH_R='/opt/rt3/local/po'
-LOCAL_LIB_PATH='/opt/rt3/local/lib'
-LOCAL_LIB_PATH_R='/opt/rt3/local/lib'
-LOCAL_PLUGIN_PATH='/opt/rt3/local/plugins'
-LOCAL_PLUGIN_PATH_R='/opt/rt3/local/plugins'
-LTLIBOBJS=''
-MASON_DATA_PATH='/usr/local/etc/freeside/masondata'
-MASON_DATA_PATH_R='/usr/local/etc/freeside/masondata'
-MASON_HTML_PATH='/var/www/freeside/rt'
-MASON_HTML_PATH_R='/var/www/freeside/rt'
-MASON_LOCAL_HTML_PATH='/opt/rt3/local/html'
-MASON_LOCAL_HTML_PATH_R='/opt/rt3/local/html'
-MASON_SESSION_PATH='/opt/rt3/var/session_data'
-MASON_SESSION_PATH_R='/opt/rt3/var/session_data'
-PACKAGE_BUGREPORT='rt-bugs@bestpractical.com'
-PACKAGE_NAME='RT'
-PACKAGE_STRING='RT rt-4.0.21'
-PACKAGE_TARNAME='rt'
-PACKAGE_URL=''
-PACKAGE_VERSION='rt-4.0.21'
-PATH_SEPARATOR=':'
-PERL='/usr/bin/perl'
-RTGROUP='freeside'
-RT_BIN_PATH='/opt/rt3/bin'
-RT_BIN_PATH_R='/opt/rt3/bin'
-RT_DEVEL_MODE='0'
-RT_DOC_PATH='/opt/rt3/docs'
-RT_DOC_PATH_R='/opt/rt3/docs'
-RT_ETC_PATH='/opt/rt3/etc'
-RT_ETC_PATH_R='/opt/rt3/etc'
-RT_FONT_PATH='/opt/rt3/share/fonts'
-RT_FONT_PATH_R='/opt/rt3/share/fonts'
-RT_GD='0'
-RT_GPG='1'
-RT_GRAPHVIZ='1'
-RT_LEXICON_PATH='/opt/rt3/share/po'
-RT_LEXICON_PATH_R='/opt/rt3/share/po'
-RT_LIB_PATH='/opt/rt3/lib'
-RT_LIB_PATH_R='/opt/rt3/lib'
-RT_LOCAL_PATH='/opt/rt3/local'
-RT_LOCAL_PATH_R='/opt/rt3/local'
-RT_LOG_PATH='/opt/rt3/var/log'
-RT_LOG_PATH_R='/opt/rt3/var/log'
-RT_MAN_PATH='/opt/rt3/man'
-RT_MAN_PATH_R='/opt/rt3/man'
-RT_PATH='/opt/rt3'
-RT_PATH_R='/opt/rt3'
-RT_PLUGIN_PATH='/opt/rt3/plugins'
-RT_PLUGIN_PATH_R='/opt/rt3/plugins'
-RT_SBIN_PATH='/opt/rt3/sbin'
-RT_SBIN_PATH_R='/opt/rt3/sbin'
-RT_SSL_MAILGATE='0'
-RT_VAR_PATH='/opt/rt3/var'
-RT_VAR_PATH_R='/opt/rt3/var'
-RT_VERSION_MAJOR='4'
-RT_VERSION_MINOR='0'
-RT_VERSION_PATCH='21'
-SHELL='/bin/bash'
-WEB_GROUP='freeside'
-WEB_HANDLER='modperl2'
-WEB_USER='freeside'
-bindir='/opt/rt3/bin'
-build_alias=''
-customdir='/opt/rt3/local'
-custometcdir='/opt/rt3/local/etc'
-customhtmldir='/opt/rt3/local/html'
-customlexdir='/opt/rt3/local/po'
-customlibdir='/opt/rt3/local/lib'
-customplugindir='/opt/rt3/local/plugins'
-datadir='/opt/rt3/share'
-datarootdir='${prefix}/share'
-docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
-dvidir='${docdir}'
-exec_prefix='/opt/rt3'
-exp_bindir='/opt/rt3/bin'
-exp_customdir='/opt/rt3/local'
-exp_custometcdir='/opt/rt3/local/etc'
-exp_customhtmldir='/opt/rt3/local/html'
-exp_customlexdir='/opt/rt3/local/po'
-exp_customlibdir='/opt/rt3/local/lib'
-exp_customplugindir='/opt/rt3/local/plugins'
-exp_datadir='/opt/rt3/share'
-exp_exec_prefix='/opt/rt3'
-exp_fontdir='/opt/rt3/share/fonts'
-exp_htmldir='/var/www/freeside/rt'
-exp_lexdir='/opt/rt3/share/po'
-exp_libdir='/opt/rt3/lib'
-exp_localstatedir='/opt/rt3/var'
-exp_logfiledir='/opt/rt3/var/log'
-exp_mandir='/opt/rt3/man'
-exp_manualdir='/opt/rt3/docs'
-exp_masonstatedir='/usr/local/etc/freeside/masondata'
-exp_plugindir='/opt/rt3/plugins'
-exp_prefix='/opt/rt3'
-exp_sbindir='/opt/rt3/sbin'
-exp_sessionstatedir='/opt/rt3/var/session_data'
-exp_sysconfdir='/opt/rt3/etc'
-fontdir='/opt/rt3/share/fonts'
-host_alias=''
-htmldir='/var/www/freeside/rt'
-includedir='${prefix}/include'
-infodir='${datarootdir}/info'
-lexdir='/opt/rt3/share/po'
-libdir='/opt/rt3/lib'
-libexecdir='${exec_prefix}/libexec'
-localedir='${datarootdir}/locale'
-localstatedir='/opt/rt3/var'
-logfiledir='/opt/rt3/var/log'
-mandir='/opt/rt3/man'
-manualdir='/opt/rt3/docs'
-masonstatedir='/usr/local/etc/freeside/masondata'
-oldincludedir='/usr/include'
-pdfdir='${docdir}'
-plugindir='/opt/rt3/plugins'
-prefix='/opt/rt3'
-program_transform_name='s,x,x,'
-psdir='${docdir}'
-rt_layout_name='Freeside'
-rt_version_major='4'
-rt_version_minor='0'
-rt_version_patch='21'
-sbindir='/opt/rt3/sbin'
-sessionstatedir='/opt/rt3/var/session_data'
-sharedstatedir='${prefix}/com'
-sysconfdir='/opt/rt3/etc'
-target_alias=''
-
-## ----------- ##
-## confdefs.h. ##
-## ----------- ##
-
-/* confdefs.h */
-#define PACKAGE_NAME "RT"
-#define PACKAGE_TARNAME "rt"
-#define PACKAGE_VERSION "rt-4.0.21"
-#define PACKAGE_STRING "RT rt-4.0.21"
-#define PACKAGE_BUGREPORT "rt-bugs@bestpractical.com"
-#define PACKAGE_URL ""
-
-configure: exit 0
+++ /dev/null
-(test "x$prefix" = "xNONE" || test "x$prefix" = "x") && prefix=/opt/rt3
-(test "x$exec_prefix" = "xNONE" || test "x$exec_prefix" = "x") && exec_prefix=${prefix}
-bindir=${exec_prefix}/bin
-sbindir=${exec_prefix}/sbin
-sysconfdir=${prefix}/etc
-mandir=${prefix}/man
-(test "x$plugindir" = "xNONE" || test "x$plugindir" = "x") && plugindir=${prefix}/plugins
-libdir=${prefix}/lib
-datadir=${prefix}/share
-htmldir=/var/www/freeside/rt
-(test "x$fontdir" = "xNONE" || test "x$fontdir" = "x") && fontdir=${datadir}/fonts
-(test "x$lexdir" = "xNONE" || test "x$lexdir" = "x") && lexdir=${datadir}/po
-(test "x$manualdir" = "xNONE" || test "x$manualdir" = "x") && manualdir=${prefix}/docs
-localstatedir=${prefix}/var
-(test "x$logfiledir" = "xNONE" || test "x$logfiledir" = "x") && logfiledir=${localstatedir}/log
-(test "x$masonstatedir" = "xNONE" || test "x$masonstatedir" = "x") && masonstatedir=/usr/local/etc/freeside/masondata
-(test "x$sessionstatedir" = "xNONE" || test "x$sessionstatedir" = "x") && sessionstatedir=${localstatedir}/session_data
-(test "x$customdir" = "xNONE" || test "x$customdir" = "x") && customdir=${prefix}/local
-(test "x$custometcdir" = "xNONE" || test "x$custometcdir" = "x") && custometcdir=${customdir}/etc
-(test "x$customhtmldir" = "xNONE" || test "x$customhtmldir" = "x") && customhtmldir=${customdir}/html
-(test "x$customlexdir" = "xNONE" || test "x$customlexdir" = "x") && customlexdir=${customdir}/po
-(test "x$customlibdir" = "xNONE" || test "x$customlibdir" = "x") && customlibdir=${customdir}/lib
-(test "x$customplugindir" = "xNONE" || test "x$customplugindir" = "x") && customplugindir=${customdir}/plugins
+++ /dev/null
-#! /bin/bash
-# Generated by configure.
-# Run this file to recreate the current configuration.
-# Compiler output produced by configure, useful for debugging
-# configure, is in config.log if it exists.
-
-debug=false
-ac_cs_recheck=false
-ac_cs_silent=false
-
-SHELL=${CONFIG_SHELL-/bin/bash}
-export SHELL
-## -------------------- ##
-## M4sh Initialization. ##
-## -------------------- ##
-
-# Be more Bourne compatible
-DUALCASE=1; export DUALCASE # for MKS sh
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
- emulate sh
- NULLCMD=:
- # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
- # is contrary to our usage. Disable this feature.
- alias -g '${1+"$@"}'='"$@"'
- setopt NO_GLOB_SUBST
-else
- case `(set -o) 2>/dev/null` in #(
- *posix*) :
- set -o posix ;; #(
- *) :
- ;;
-esac
-fi
-
-
-as_nl='
-'
-export as_nl
-# Printing a long string crashes Solaris 7 /usr/bin/printf.
-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
-# Prefer a ksh shell builtin over an external printf program on Solaris,
-# but without wasting forks for bash or zsh.
-if test -z "$BASH_VERSION$ZSH_VERSION" \
- && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='print -r --'
- as_echo_n='print -rn --'
-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
- as_echo='printf %s\n'
- as_echo_n='printf %s'
-else
- if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
- as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
- as_echo_n='/usr/ucb/echo -n'
- else
- as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
- as_echo_n_body='eval
- arg=$1;
- case $arg in #(
- *"$as_nl"*)
- expr "X$arg" : "X\\(.*\\)$as_nl";
- arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
- esac;
- expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
- '
- export as_echo_n_body
- as_echo_n='sh -c $as_echo_n_body as_echo'
- fi
- export as_echo_body
- as_echo='sh -c $as_echo_body as_echo'
-fi
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- PATH_SEPARATOR=:
- (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
- (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
- PATH_SEPARATOR=';'
- }
-fi
-
-
-# IFS
-# We need space, tab and new line, in precisely that order. Quoting is
-# there to prevent editors from complaining about space-tab.
-# (If _AS_PATH_WALK were called with IFS unset, it would disable word
-# splitting by setting IFS to empty value.)
-IFS=" "" $as_nl"
-
-# Find who we are. Look in the path if we contain no directory separator.
-as_myself=
-case $0 in #((
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
- done
-IFS=$as_save_IFS
-
- ;;
-esac
-# We did not find ourselves, most probably we were run as `sh COMMAND'
-# in which case we are not to be found in the path.
-if test "x$as_myself" = x; then
- as_myself=$0
-fi
-if test ! -f "$as_myself"; then
- $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
- exit 1
-fi
-
-# Unset variables that we do not need and which cause bugs (e.g. in
-# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
-# suppresses any "Segmentation fault" message there. '((' could
-# trigger a bug in pdksh 5.2.14.
-for as_var in BASH_ENV ENV MAIL MAILPATH
-do eval test x\${$as_var+set} = xset \
- && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
-done
-PS1='$ '
-PS2='> '
-PS4='+ '
-
-# NLS nuisances.
-LC_ALL=C
-export LC_ALL
-LANGUAGE=C
-export LANGUAGE
-
-# CDPATH.
-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
-
-
-# as_fn_error STATUS ERROR [LINENO LOG_FD]
-# ----------------------------------------
-# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
-# script with STATUS, using 1 if that was 0.
-as_fn_error ()
-{
- as_status=$1; test $as_status -eq 0 && as_status=1
- if test "$4"; then
- as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
- fi
- $as_echo "$as_me: error: $2" >&2
- as_fn_exit $as_status
-} # as_fn_error
-
-
-# as_fn_set_status STATUS
-# -----------------------
-# Set $? to STATUS, without forking.
-as_fn_set_status ()
-{
- return $1
-} # as_fn_set_status
-
-# as_fn_exit STATUS
-# -----------------
-# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
-as_fn_exit ()
-{
- set +e
- as_fn_set_status $1
- exit $1
-} # as_fn_exit
-
-# as_fn_unset VAR
-# ---------------
-# Portably unset VAR.
-as_fn_unset ()
-{
- { eval $1=; unset $1;}
-}
-as_unset=as_fn_unset
-# as_fn_append VAR VALUE
-# ----------------------
-# Append the text in VALUE to the end of the definition contained in VAR. Take
-# advantage of any shell optimizations that allow amortized linear growth over
-# repeated appends, instead of the typical quadratic growth present in naive
-# implementations.
-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
- eval 'as_fn_append ()
- {
- eval $1+=\$2
- }'
-else
- as_fn_append ()
- {
- eval $1=\$$1\$2
- }
-fi # as_fn_append
-
-# as_fn_arith ARG...
-# ------------------
-# Perform arithmetic evaluation on the ARGs, and store the result in the
-# global $as_val. Take advantage of shells that can avoid forks. The arguments
-# must be portable across $(()) and expr.
-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
- eval 'as_fn_arith ()
- {
- as_val=$(( $* ))
- }'
-else
- as_fn_arith ()
- {
- as_val=`expr "$@" || test $? -eq 1`
- }
-fi # as_fn_arith
-
-
-if expr a : '\(a\)' >/dev/null 2>&1 &&
- test "X`expr 00001 : '.*\(...\)'`" = X001; then
- as_expr=expr
-else
- as_expr=false
-fi
-
-if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
- as_basename=basename
-else
- as_basename=false
-fi
-
-if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
- as_dirname=dirname
-else
- as_dirname=false
-fi
-
-as_me=`$as_basename -- "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{
- s//\1/
- q
- }
- /^X\/\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\/\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
-
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-ECHO_C= ECHO_N= ECHO_T=
-case `echo -n x` in #(((((
--n*)
- case `echo 'xy\c'` in
- *c*) ECHO_T=' ';; # ECHO_T is single tab character.
- xy) ECHO_C='\c';;
- *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
- ECHO_T=' ';;
- esac;;
-*)
- ECHO_N='-n';;
-esac
-
-rm -f conf$$ conf$$.exe conf$$.file
-if test -d conf$$.dir; then
- rm -f conf$$.dir/conf$$.file
-else
- rm -f conf$$.dir
- mkdir conf$$.dir 2>/dev/null
-fi
-if (echo >conf$$.file) 2>/dev/null; then
- if ln -s conf$$.file conf$$ 2>/dev/null; then
- as_ln_s='ln -s'
- # ... but there are two gotchas:
- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
- elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
- else
- as_ln_s='cp -p'
- fi
-else
- as_ln_s='cp -p'
-fi
-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
-rmdir conf$$.dir 2>/dev/null
-
-
-# as_fn_mkdir_p
-# -------------
-# Create "$as_dir" as a directory, including parents if necessary.
-as_fn_mkdir_p ()
-{
-
- case $as_dir in #(
- -*) as_dir=./$as_dir;;
- esac
- test -d "$as_dir" || eval $as_mkdir_p || {
- as_dirs=
- while :; do
- case $as_dir in #(
- *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
- *) as_qdir=$as_dir;;
- esac
- as_dirs="'$as_qdir' $as_dirs"
- as_dir=`$as_dirname -- "$as_dir" ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- test -d "$as_dir" && break
- done
- test -z "$as_dirs" || eval "mkdir $as_dirs"
- } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
-
-
-} # as_fn_mkdir_p
-if mkdir -p . 2>/dev/null; then
- as_mkdir_p='mkdir -p "$as_dir"'
-else
- test -d ./-p && rmdir ./-p
- as_mkdir_p=false
-fi
-
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
-
-# Sed expression to map a string onto a valid CPP name.
-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
-
-# Sed expression to map a string onto a valid variable name.
-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-
-
-exec 6>&1
-## ----------------------------------- ##
-## Main body of $CONFIG_STATUS script. ##
-## ----------------------------------- ##
-# Save the log message, to keep $0 and so on meaningful, and to
-# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling.
-ac_log="
-This file was extended by RT $as_me rt-4.0.21, which was
-generated by GNU Autoconf 2.68. Invocation command line was
-
- CONFIG_FILES = $CONFIG_FILES
- CONFIG_HEADERS = $CONFIG_HEADERS
- CONFIG_LINKS = $CONFIG_LINKS
- CONFIG_COMMANDS = $CONFIG_COMMANDS
- $ $0 $@
-
-on `(hostname || uname -n) 2>/dev/null | sed 1q`
-"
-
-# Files that config.status was made for.
-config_files=" etc/upgrade/3.8-ical-extension etc/upgrade/4.0-customfield-checkbox-extension etc/upgrade/split-out-cf-categories etc/upgrade/generate-rtaddressregexp etc/upgrade/upgrade-articles etc/upgrade/vulnerable-passwords sbin/rt-attributes-viewer sbin/rt-preferences-viewer sbin/rt-session-viewer sbin/rt-dump-metadata sbin/rt-setup-database sbin/rt-test-dependencies sbin/rt-email-digest sbin/rt-email-dashboards sbin/rt-clean-sessions sbin/rt-shredder sbin/rt-validator sbin/rt-validate-aliases sbin/rt-email-group-admin sbin/rt-server sbin/rt-server.fcgi sbin/standalone_httpd sbin/rt-setup-fulltext-index sbin/rt-fulltext-indexer bin/rt-crontool bin/rt-mailgate bin/rt Makefile etc/RT_Config.pm lib/RT/Generated.pm t/data/configs/apache2.2+mod_perl.conf t/data/configs/apache2.2+fastcgi.conf"
-
-ac_cs_usage="\
-\`$as_me' instantiates files and other configuration actions
-from templates according to the current configuration. Unless the files
-and actions are specified as TAGs, all are instantiated by default.
-
-Usage: $0 [OPTION]... [TAG]...
-
- -h, --help print this help, then exit
- -V, --version print version number and configuration settings, then exit
- --config print configuration, then exit
- -q, --quiet, --silent
- do not print progress messages
- -d, --debug don't remove temporary files
- --recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
-
-Configuration files:
-$config_files
-
-Report bugs to <rt-bugs@bestpractical.com>."
-
-ac_cs_config="'--enable-layout=Freeside' '--with-db-type=Pg' '--with-db-dba=freeside' '--with-db-database=freeside' '--with-db-rt-user=freeside' '--with-db-rt-pass=' '--with-web-user=freeside' '--with-web-group=freeside' '--with-rt-group=freeside' '--with-web-handler=modperl2'"
-ac_cs_version="\
-RT config.status rt-4.0.21
-configured by ./configure, generated by GNU Autoconf 2.68,
- with options \"$ac_cs_config\"
-
-Copyright (C) 2010 Free Software Foundation, Inc.
-This config.status script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it."
-
-ac_pwd='/home/ivan/freeside/rt'
-srcdir='.'
-INSTALL='/usr/bin/install -c'
-test -n "$AWK" || AWK=awk
-# The default lists apply if the user does not specify any file.
-ac_need_defaults=:
-while test $# != 0
-do
- case $1 in
- --*=?*)
- ac_option=`expr "X$1" : 'X\([^=]*\)='`
- ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
- ac_shift=:
- ;;
- --*=)
- ac_option=`expr "X$1" : 'X\([^=]*\)='`
- ac_optarg=
- ac_shift=:
- ;;
- *)
- ac_option=$1
- ac_optarg=$2
- ac_shift=shift
- ;;
- esac
-
- case $ac_option in
- # Handling of the options.
- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
- ac_cs_recheck=: ;;
- --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
- $as_echo "$ac_cs_version"; exit ;;
- --config | --confi | --conf | --con | --co | --c )
- $as_echo "$ac_cs_config"; exit ;;
- --debug | --debu | --deb | --de | --d | -d )
- debug=: ;;
- --file | --fil | --fi | --f )
- $ac_shift
- case $ac_optarg in
- *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
- '') as_fn_error $? "missing file argument" ;;
- esac
- as_fn_append CONFIG_FILES " '$ac_optarg'"
- ac_need_defaults=false;;
- --he | --h | --help | --hel | -h )
- $as_echo "$ac_cs_usage"; exit ;;
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil | --si | --s)
- ac_cs_silent=: ;;
-
- # This is an error.
- -*) as_fn_error $? "unrecognized option: \`$1'
-Try \`$0 --help' for more information." ;;
-
- *) as_fn_append ac_config_targets " $1"
- ac_need_defaults=false ;;
-
- esac
- shift
-done
-
-ac_configure_extra_args=
-
-if $ac_cs_silent; then
- exec 6>/dev/null
- ac_configure_extra_args="$ac_configure_extra_args --silent"
-fi
-
-if $ac_cs_recheck; then
- set X '/bin/bash' './configure' '--enable-layout=Freeside' '--with-db-type=Pg' '--with-db-dba=freeside' '--with-db-database=freeside' '--with-db-rt-user=freeside' '--with-db-rt-pass=' '--with-web-user=freeside' '--with-web-group=freeside' '--with-rt-group=freeside' '--with-web-handler=modperl2' $ac_configure_extra_args --no-create --no-recursion
- shift
- $as_echo "running CONFIG_SHELL=/bin/bash $*" >&6
- CONFIG_SHELL='/bin/bash'
- export CONFIG_SHELL
- exec "$@"
-fi
-
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
- $as_echo "$ac_log"
-} >&5
-
-
-# Handling of arguments.
-for ac_config_target in $ac_config_targets
-do
- case $ac_config_target in
- "etc/upgrade/3.8-ical-extension") CONFIG_FILES="$CONFIG_FILES etc/upgrade/3.8-ical-extension" ;;
- "etc/upgrade/4.0-customfield-checkbox-extension") CONFIG_FILES="$CONFIG_FILES etc/upgrade/4.0-customfield-checkbox-extension" ;;
- "etc/upgrade/split-out-cf-categories") CONFIG_FILES="$CONFIG_FILES etc/upgrade/split-out-cf-categories" ;;
- "etc/upgrade/generate-rtaddressregexp") CONFIG_FILES="$CONFIG_FILES etc/upgrade/generate-rtaddressregexp" ;;
- "etc/upgrade/upgrade-articles") CONFIG_FILES="$CONFIG_FILES etc/upgrade/upgrade-articles" ;;
- "etc/upgrade/vulnerable-passwords") CONFIG_FILES="$CONFIG_FILES etc/upgrade/vulnerable-passwords" ;;
- "sbin/rt-attributes-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-attributes-viewer" ;;
- "sbin/rt-preferences-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-preferences-viewer" ;;
- "sbin/rt-session-viewer") CONFIG_FILES="$CONFIG_FILES sbin/rt-session-viewer" ;;
- "sbin/rt-dump-metadata") CONFIG_FILES="$CONFIG_FILES sbin/rt-dump-metadata" ;;
- "sbin/rt-setup-database") CONFIG_FILES="$CONFIG_FILES sbin/rt-setup-database" ;;
- "sbin/rt-test-dependencies") CONFIG_FILES="$CONFIG_FILES sbin/rt-test-dependencies" ;;
- "sbin/rt-email-digest") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-digest" ;;
- "sbin/rt-email-dashboards") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-dashboards" ;;
- "sbin/rt-clean-sessions") CONFIG_FILES="$CONFIG_FILES sbin/rt-clean-sessions" ;;
- "sbin/rt-shredder") CONFIG_FILES="$CONFIG_FILES sbin/rt-shredder" ;;
- "sbin/rt-validator") CONFIG_FILES="$CONFIG_FILES sbin/rt-validator" ;;
- "sbin/rt-validate-aliases") CONFIG_FILES="$CONFIG_FILES sbin/rt-validate-aliases" ;;
- "sbin/rt-email-group-admin") CONFIG_FILES="$CONFIG_FILES sbin/rt-email-group-admin" ;;
- "sbin/rt-server") CONFIG_FILES="$CONFIG_FILES sbin/rt-server" ;;
- "sbin/rt-server.fcgi") CONFIG_FILES="$CONFIG_FILES sbin/rt-server.fcgi" ;;
- "sbin/standalone_httpd") CONFIG_FILES="$CONFIG_FILES sbin/standalone_httpd" ;;
- "sbin/rt-setup-fulltext-index") CONFIG_FILES="$CONFIG_FILES sbin/rt-setup-fulltext-index" ;;
- "sbin/rt-fulltext-indexer") CONFIG_FILES="$CONFIG_FILES sbin/rt-fulltext-indexer" ;;
- "bin/rt-crontool") CONFIG_FILES="$CONFIG_FILES bin/rt-crontool" ;;
- "bin/rt-mailgate") CONFIG_FILES="$CONFIG_FILES bin/rt-mailgate" ;;
- "bin/rt") CONFIG_FILES="$CONFIG_FILES bin/rt" ;;
- "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "etc/RT_Config.pm") CONFIG_FILES="$CONFIG_FILES etc/RT_Config.pm" ;;
- "lib/RT/Generated.pm") CONFIG_FILES="$CONFIG_FILES lib/RT/Generated.pm" ;;
- "t/data/configs/apache2.2+mod_perl.conf") CONFIG_FILES="$CONFIG_FILES t/data/configs/apache2.2+mod_perl.conf" ;;
- "t/data/configs/apache2.2+fastcgi.conf") CONFIG_FILES="$CONFIG_FILES t/data/configs/apache2.2+fastcgi.conf" ;;
-
- *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
- esac
-done
-
-
-# If the user did not use the arguments to specify the items to instantiate,
-# then the envvar interface is used. Set only those that are not.
-# We use the long form for the default assignment because of an extremely
-# bizarre bug on SunOS 4.1.3.
-if $ac_need_defaults; then
- test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
-fi
-
-# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason against having it here, and in addition,
-# creating and moving files from /tmp can sometimes cause problems.
-# Hook for its removal unless debugging.
-# Note that there is a small window in which the directory will not be cleaned:
-# after its creation but before its name has been assigned to `$tmp'.
-$debug ||
-{
- tmp= ac_tmp=
- trap 'exit_status=$?
- : "${ac_tmp:=$tmp}"
- { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
-' 0
- trap 'as_fn_exit 1' 1 2 13 15
-}
-# Create a (secure) tmp directory for tmp files.
-
-{
- tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
- test -d "$tmp"
-} ||
-{
- tmp=./conf$$-$RANDOM
- (umask 077 && mkdir "$tmp")
-} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
-ac_tmp=$tmp
-
-# Set up the scripts for CONFIG_FILES section.
-# No need to generate them if there are no CONFIG_FILES.
-# This happens for instance with `./config.status config.h'.
-if test -n "$CONFIG_FILES"; then
-
-
-ac_cr=`echo X | tr X '\015'`
-# On cygwin, bash can eat \r inside `` if the user requested igncr.
-# But we know of no other shell where ac_cr would be empty at this
-# point, so we can use a bashism as a fallback.
-if test "x$ac_cr" = x; then
- eval ac_cr=\$\'\\r\'
-fi
-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
- ac_cs_awk_cr='\\r'
-else
- ac_cs_awk_cr=$ac_cr
-fi
-
-echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
-cat >>"$ac_tmp/subs1.awk" <<\_ACAWK &&
-S["LTLIBOBJS"]=""
-S["LIBOBJS"]=""
-S["RT_LOG_PATH_R"]="/opt/rt3/var/log"
-S["LOCAL_PLUGIN_PATH_R"]="/opt/rt3/local/plugins"
-S["LOCAL_LIB_PATH_R"]="/opt/rt3/local/lib"
-S["LOCAL_LEXICON_PATH_R"]="/opt/rt3/local/po"
-S["MASON_LOCAL_HTML_PATH_R"]="/opt/rt3/local/html"
-S["LOCAL_ETC_PATH_R"]="/opt/rt3/local/etc"
-S["MASON_HTML_PATH_R"]="/var/www/freeside/rt"
-S["MASON_SESSION_PATH_R"]="/opt/rt3/var/session_data"
-S["MASON_DATA_PATH_R"]="/usr/local/etc/freeside/masondata"
-S["RT_PLUGIN_PATH_R"]="/opt/rt3/plugins"
-S["RT_LEXICON_PATH_R"]="/opt/rt3/share/po"
-S["RT_FONT_PATH_R"]="/opt/rt3/share/fonts"
-S["RT_MAN_PATH_R"]="/opt/rt3/man"
-S["RT_VAR_PATH_R"]="/opt/rt3/var"
-S["RT_SBIN_PATH_R"]="/opt/rt3/sbin"
-S["RT_BIN_PATH_R"]="/opt/rt3/bin"
-S["CONFIG_FILE_PATH_R"]="/opt/rt3/etc"
-S["RT_ETC_PATH_R"]="/opt/rt3/etc"
-S["RT_LIB_PATH_R"]="/opt/rt3/lib"
-S["RT_LOCAL_PATH_R"]="/opt/rt3/local"
-S["RT_DOC_PATH_R"]="/opt/rt3/docs"
-S["RT_PATH_R"]="/opt/rt3"
-S["RT_LOG_PATH"]="/opt/rt3/var/log"
-S["LOCAL_PLUGIN_PATH"]="/opt/rt3/local/plugins"
-S["LOCAL_LIB_PATH"]="/opt/rt3/local/lib"
-S["LOCAL_LEXICON_PATH"]="/opt/rt3/local/po"
-S["MASON_LOCAL_HTML_PATH"]="/opt/rt3/local/html"
-S["LOCAL_ETC_PATH"]="/opt/rt3/local/etc"
-S["MASON_HTML_PATH"]="/var/www/freeside/rt"
-S["MASON_SESSION_PATH"]="/opt/rt3/var/session_data"
-S["MASON_DATA_PATH"]="/usr/local/etc/freeside/masondata"
-S["RT_PLUGIN_PATH"]="/opt/rt3/plugins"
-S["RT_FONT_PATH"]="/opt/rt3/share/fonts"
-S["RT_MAN_PATH"]="/opt/rt3/man"
-S["RT_VAR_PATH"]="/opt/rt3/var"
-S["RT_SBIN_PATH"]="/opt/rt3/sbin"
-S["RT_BIN_PATH"]="/opt/rt3/bin"
-S["CONFIG_FILE_PATH"]="/opt/rt3/etc"
-S["RT_ETC_PATH"]="/opt/rt3/etc"
-S["RT_LEXICON_PATH"]="/opt/rt3/share/po"
-S["RT_LIB_PATH"]="/opt/rt3/lib"
-S["RT_LOCAL_PATH"]="/opt/rt3/local"
-S["RT_DOC_PATH"]="/opt/rt3/docs"
-S["RT_PATH"]="/opt/rt3"
-S["RT_VERSION_PATCH"]="21"
-S["RT_VERSION_MINOR"]="0"
-S["RT_VERSION_MAJOR"]="4"
-S["RT_SSL_MAILGATE"]="0"
-S["RT_GPG"]="1"
-S["RT_GD"]="0"
-S["RT_GRAPHVIZ"]="1"
-S["RT_DEVEL_MODE"]="0"
-S["APACHECTL"]="/usr/sbin/apachectl"
-S["RTGROUP"]="freeside"
-S["WEB_GROUP"]="freeside"
-S["WEB_USER"]="freeside"
-S["DB_RT_PASS"]=""
-S["DB_RT_USER"]="freeside"
-S["DB_DATABASE"]="freeside"
-S["DB_DBA"]="freeside"
-S["DB_RT_HOST"]="localhost"
-S["DB_PORT"]=""
-S["DB_HOST"]="localhost"
-S["DATABASE_ENV_PREF"]=""
-S["DB_TYPE"]="Pg"
-S["LIBS_GROUP"]="bin"
-S["LIBS_OWNER"]="root"
-S["BIN_OWNER"]="root"
-S["COMMENT_INPLACE_LAYOUT"]=""
-S["rt_layout_name"]="Freeside"
-S["exp_customlibdir"]="/opt/rt3/local/lib"
-S["customlibdir"]="/opt/rt3/local/lib"
-S["exp_customlexdir"]="/opt/rt3/local/po"
-S["customlexdir"]="/opt/rt3/local/po"
-S["exp_customhtmldir"]="/opt/rt3/local/html"
-S["customhtmldir"]="/opt/rt3/local/html"
-S["exp_customplugindir"]="/opt/rt3/local/plugins"
-S["customplugindir"]="/opt/rt3/local/plugins"
-S["exp_custometcdir"]="/opt/rt3/local/etc"
-S["custometcdir"]="/opt/rt3/local/etc"
-S["exp_customdir"]="/opt/rt3/local"
-S["customdir"]="/opt/rt3/local"
-S["exp_sessionstatedir"]="/opt/rt3/var/session_data"
-S["sessionstatedir"]="/opt/rt3/var/session_data"
-S["exp_masonstatedir"]="/usr/local/etc/freeside/masondata"
-S["masonstatedir"]="/usr/local/etc/freeside/masondata"
-S["exp_logfiledir"]="/opt/rt3/var/log"
-S["logfiledir"]="/opt/rt3/var/log"
-S["exp_localstatedir"]="/opt/rt3/var"
-S["exp_plugindir"]="/opt/rt3/plugins"
-S["plugindir"]="/opt/rt3/plugins"
-S["exp_manualdir"]="/opt/rt3/docs"
-S["manualdir"]="/opt/rt3/docs"
-S["exp_fontdir"]="/opt/rt3/share/fonts"
-S["fontdir"]="/opt/rt3/share/fonts"
-S["exp_htmldir"]="/var/www/freeside/rt"
-S["exp_datadir"]="/opt/rt3/share"
-S["exp_lexdir"]="/opt/rt3/share/po"
-S["lexdir"]="/opt/rt3/share/po"
-S["exp_libdir"]="/opt/rt3/lib"
-S["exp_mandir"]="/opt/rt3/man"
-S["exp_sysconfdir"]="/opt/rt3/etc"
-S["exp_sbindir"]="/opt/rt3/sbin"
-S["exp_bindir"]="/opt/rt3/bin"
-S["exp_exec_prefix"]="/opt/rt3"
-S["exp_prefix"]="/opt/rt3"
-S["WEB_HANDLER"]="modperl2"
-S["PERL"]="/usr/bin/perl"
-S["INSTALL_DATA"]="${INSTALL} -m 644"
-S["INSTALL_SCRIPT"]="${INSTALL}"
-S["INSTALL_PROGRAM"]="${INSTALL}"
-S["rt_version_patch"]="21"
-S["rt_version_minor"]="0"
-S["rt_version_major"]="4"
-S["CONFIGURE_INCANT"]="./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pa"\
-"ss= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2"
-S["target_alias"]=""
-S["host_alias"]=""
-S["build_alias"]=""
-S["LIBS"]=""
-S["ECHO_T"]=""
-S["ECHO_N"]="-n"
-S["ECHO_C"]=""
-S["DEFS"]="-DPACKAGE_NAME=\\\"RT\\\" -DPACKAGE_TARNAME=\\\"rt\\\" -DPACKAGE_VERSION=\\\"rt-4.0.21\\\" -DPACKAGE_STRING=\\\"RT\\ rt-4.0.21\\\" -DPACKAGE_BUGREPORT=\\\"rt-bugs@best"\
-"practical.com\\\" -DPACKAGE_URL=\\\"\\\""
-S["mandir"]="/opt/rt3/man"
-S["localedir"]="${datarootdir}/locale"
-S["libdir"]="/opt/rt3/lib"
-S["psdir"]="${docdir}"
-S["pdfdir"]="${docdir}"
-S["dvidir"]="${docdir}"
-S["htmldir"]="/var/www/freeside/rt"
-S["infodir"]="${datarootdir}/info"
-S["docdir"]="${datarootdir}/doc/${PACKAGE_TARNAME}"
-S["oldincludedir"]="/usr/include"
-S["includedir"]="${prefix}/include"
-S["localstatedir"]="/opt/rt3/var"
-S["sharedstatedir"]="${prefix}/com"
-S["sysconfdir"]="/opt/rt3/etc"
-S["datadir"]="/opt/rt3/share"
-S["datarootdir"]="${prefix}/share"
-S["libexecdir"]="${exec_prefix}/libexec"
-S["sbindir"]="/opt/rt3/sbin"
-S["bindir"]="/opt/rt3/bin"
-S["program_transform_name"]="s,x,x,"
-S["prefix"]="/opt/rt3"
-S["exec_prefix"]="/opt/rt3"
-S["PACKAGE_URL"]=""
-S["PACKAGE_BUGREPORT"]="rt-bugs@bestpractical.com"
-S["PACKAGE_STRING"]="RT rt-4.0.21"
-S["PACKAGE_VERSION"]="rt-4.0.21"
-S["PACKAGE_TARNAME"]="rt"
-S["PACKAGE_NAME"]="RT"
-S["PATH_SEPARATOR"]=":"
-S["SHELL"]="/bin/bash"
-_ACAWK
-cat >>"$ac_tmp/subs1.awk" <<_ACAWK &&
- for (key in S) S_is_set[key] = 1
- FS = "\a"
-
-}
-{
- line = $ 0
- nfields = split(line, field, "@")
- substed = 0
- len = length(field[1])
- for (i = 2; i < nfields; i++) {
- key = field[i]
- keylen = length(key)
- if (S_is_set[key]) {
- value = S[key]
- line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
- len += length(value) + length(field[++i])
- substed = 1
- } else
- len += 1 + keylen
- }
-
- print line
-}
-
-_ACAWK
-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
- sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
-else
- cat
-fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
- || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
-fi # test -n "$CONFIG_FILES"
-
-
-eval set X " :F $CONFIG_FILES "
-shift
-for ac_tag
-do
- case $ac_tag in
- :[FHLC]) ac_mode=$ac_tag; continue;;
- esac
- case $ac_mode$ac_tag in
- :[FHL]*:*);;
- :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
- :[FH]-) ac_tag=-:-;;
- :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
- esac
- ac_save_IFS=$IFS
- IFS=:
- set x $ac_tag
- IFS=$ac_save_IFS
- shift
- ac_file=$1
- shift
-
- case $ac_mode in
- :L) ac_source=$1;;
- :[FH])
- ac_file_inputs=
- for ac_f
- do
- case $ac_f in
- -) ac_f="$ac_tmp/stdin";;
- *) # Look for the file first in the build tree, then in the source tree
- # (if the path is not absolute). The absolute path cannot be DOS-style,
- # because $ac_f cannot contain `:'.
- test -f "$ac_f" ||
- case $ac_f in
- [\\/$]*) false;;
- *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
- esac ||
- as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
- esac
- case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
- as_fn_append ac_file_inputs " '$ac_f'"
- done
-
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- configure_input='Generated from '`
- $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
- `' by configure.'
- if test x"$ac_file" != x-; then
- configure_input="$ac_file. $configure_input"
- { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
-$as_echo "$as_me: creating $ac_file" >&6;}
- fi
- # Neutralize special characters interpreted by sed in replacement strings.
- case $configure_input in #(
- *\&* | *\|* | *\\* )
- ac_sed_conf_input=`$as_echo "$configure_input" |
- sed 's/[\\\\&|]/\\\\&/g'`;; #(
- *) ac_sed_conf_input=$configure_input;;
- esac
-
- case $ac_tag in
- *:-:* | *:-) cat >"$ac_tmp/stdin" \
- || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
- esac
- ;;
- esac
-
- ac_dir=`$as_dirname -- "$ac_file" ||
-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_file" : 'X\(//\)[^/]' \| \
- X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
-$as_echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
- s//\1/
- q
- }
- /^X\(\/\/\)[^/].*/{
- s//\1/
- q
- }
- /^X\(\/\/\)$/{
- s//\1/
- q
- }
- /^X\(\/\).*/{
- s//\1/
- q
- }
- s/.*/./; q'`
- as_dir="$ac_dir"; as_fn_mkdir_p
- ac_builddir=.
-
-case "$ac_dir" in
-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
-*)
- ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
- # A ".." for each directory in $ac_dir_suffix.
- ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
- case $ac_top_builddir_sub in
- "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
- *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
- esac ;;
-esac
-ac_abs_top_builddir=$ac_pwd
-ac_abs_builddir=$ac_pwd$ac_dir_suffix
-# for backward compatibility:
-ac_top_builddir=$ac_top_build_prefix
-
-case $srcdir in
- .) # We are building in place.
- ac_srcdir=.
- ac_top_srcdir=$ac_top_builddir_sub
- ac_abs_top_srcdir=$ac_pwd ;;
- [\\/]* | ?:[\\/]* ) # Absolute name.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir
- ac_abs_top_srcdir=$srcdir ;;
- *) # Relative name.
- ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_build_prefix$srcdir
- ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
-esac
-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
-
-
- case $ac_mode in
- :F)
- #
- # CONFIG_FILE
- #
-
- case $INSTALL in
- [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;;
- *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;;
- esac
-# If the template does not know about datarootdir, expand it.
-# FIXME: This hack should be removed a few years after 2.60.
-ac_datarootdir_hack=; ac_datarootdir_seen=
-ac_sed_dataroot='
-/datarootdir/ {
- p
- q
-}
-/@datadir@/p
-/@docdir@/p
-/@infodir@/p
-/@localedir@/p
-/@mandir@/p'
-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
-*datarootdir*) ac_datarootdir_seen=yes;;
-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
- ac_datarootdir_hack='
- s&@datadir@&/opt/rt3/share&g
- s&@docdir@&${datarootdir}/doc/${PACKAGE_TARNAME}&g
- s&@infodir@&${datarootdir}/info&g
- s&@localedir@&${datarootdir}/locale&g
- s&@mandir@&/opt/rt3/man&g
- s&\${datarootdir}&${prefix}/share&g' ;;
-esac
-ac_sed_extra="/^[ ]*VPATH[ ]*=[ ]*/{
-h
-s///
-s/^/:/
-s/[ ]*$/:/
-s/:\$(srcdir):/:/g
-s/:\${srcdir}:/:/g
-s/:@srcdir@:/:/g
-s/^:*//
-s/:*$//
-x
-s/\(=[ ]*\).*/\1/
-G
-s/\n//
-s/^[^=]*=[ ]*$//
-}
-
-:t
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s|@configure_input@|$ac_sed_conf_input|;t t
-s&@top_builddir@&$ac_top_builddir_sub&;t t
-s&@top_build_prefix@&$ac_top_build_prefix&;t t
-s&@srcdir@&$ac_srcdir&;t t
-s&@abs_srcdir@&$ac_abs_srcdir&;t t
-s&@top_srcdir@&$ac_top_srcdir&;t t
-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
-s&@builddir@&$ac_builddir&;t t
-s&@abs_builddir@&$ac_abs_builddir&;t t
-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
-s&@INSTALL@&$ac_INSTALL&;t t
-$ac_datarootdir_hack
-"
-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
- >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
-
-test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
- { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
- { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \
- "$ac_tmp/out"`; test -z "$ac_out"; } &&
- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
-which seems to be undefined. Please make sure it is defined" >&5
-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
-which seems to be undefined. Please make sure it is defined" >&2;}
-
- rm -f "$ac_tmp/stdin"
- case $ac_file in
- -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
- *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
- esac \
- || as_fn_error $? "could not create $ac_file" "$LINENO" 5
- ;;
-
-
-
- esac
-
-
- case $ac_file$ac_mode in
- "etc/upgrade/3.8-ical-extension":F) chmod ug+x $ac_file
- ;;
- "etc/upgrade/4.0-customfield-checkbox-extension":F) chmod ug+x $ac_file
- ;;
- "etc/upgrade/split-out-cf-categories":F) chmod ug+x $ac_file
- ;;
- "etc/upgrade/generate-rtaddressregexp":F) chmod ug+x $ac_file
- ;;
- "etc/upgrade/upgrade-articles":F) chmod ug+x $ac_file
- ;;
- "etc/upgrade/vulnerable-passwords":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-attributes-viewer":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-preferences-viewer":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-session-viewer":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-dump-metadata":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-setup-database":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-test-dependencies":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-email-digest":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-email-dashboards":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-clean-sessions":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-shredder":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-validator":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-validate-aliases":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-email-group-admin":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-server":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-server.fcgi":F) chmod ug+x $ac_file
- ;;
- "sbin/standalone_httpd":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-setup-fulltext-index":F) chmod ug+x $ac_file
- ;;
- "sbin/rt-fulltext-indexer":F) chmod ug+x $ac_file
- ;;
- "bin/rt-crontool":F) chmod ug+x $ac_file
- ;;
- "bin/rt-mailgate":F) chmod ug+x $ac_file
- ;;
- "bin/rt":F) chmod ug+x $ac_file
- ;;
-
- esac
-done # for ac_tag
-
-
-as_fn_exit 0
+++ /dev/null
-#
-# RT was configured with:
-#
-# $ ./configure --enable-layout=Freeside --with-db-type=Pg --with-db-dba=freeside --with-db-database=freeside --with-db-rt-user=freeside --with-db-rt-pass= --with-web-user=freeside --with-web-group=freeside --with-rt-group=freeside --with-web-handler=modperl2
-#
-
-package RT;
-
-############################# WARNING #############################
-# #
-# NEVER EDIT RT_Config.pm ! #
-# #
-# Instead, copy any sections you want to change to #
-# RT_SiteConfig.pm and edit them there. Otherwise, #
-# your changes will be lost when you upgrade RT. #
-# #
-############################# WARNING #############################
-
-=head1 NAME
-
-RT::Config
-
-=head1 Base configuration
-
-=over 4
-
-=item C<$rtname>
-
-C<$rtname> is the string that RT will look for in mail messages to
-figure out what ticket a new piece of mail belongs to.
-
-Your domain name is recommended, so as not to pollute the namespace.
-Once you start using a given tag, you should probably never change it;
-otherwise, mail for existing tickets won't get put in the right place.
-
-=cut
-
-Set($rtname, "example.com");
-
-=item C<$Organization>
-
-You should set this to your organization's DNS domain. For example,
-I<fsck.com> or I<asylum.arkham.ma.us>. It is used by the linking
-interface to guarantee that ticket URIs are unique and easy to
-construct. Changing it after you have created tickets in the system
-will B<break> all existing ticket links!
-
-=cut
-
-Set($Organization, "example.com");
-
-=item C<$CorrespondAddress>, C<$CommentAddress>
-
-RT is designed such that any mail which already has a ticket-id
-associated with it will get to the right place automatically.
-
-C<$CorrespondAddress> and C<$CommentAddress> are the default addresses
-that will be listed in From: and Reply-To: headers of correspondence
-and comment mail tracked by RT, unless overridden by a queue-specific
-address. They should be set to email addresses which have been
-configured as aliases for F<rt-mailgate>.
-
-=cut
-
-Set($CorrespondAddress, '');
-
-Set($CommentAddress, '');
-
-=item C<$WebDomain>
-
-Domain name of the RT server, e.g. 'www.example.com'. It should not
-contain anything except the server name.
-
-=cut
-
-Set($WebDomain, "localhost");
-
-=item C<$WebPort>
-
-If we're running as a superuser, run on port 80. Otherwise, pick a
-high port for this user.
-
-443 is default port for https protocol.
-
-=cut
-
-Set($WebPort, 80);
-
-=item C<$WebPath>
-
-If you're putting the web UI somewhere other than at the root of your
-server, you should set C<$WebPath> to the path you'll be serving RT
-at.
-
-C<$WebPath> requires a leading / but no trailing /, or it can be
-blank.
-
-In most cases, you should leave C<$WebPath> set to "" (an empty
-value).
-
-=cut
-
-Set($WebPath, "");
-
-=item C<$Timezone>
-
-C<$Timezone> is the default timezone, used to convert times entered by
-users into GMT, as they are stored in the database, and back again;
-users can override this. It should be set to a timezone recognized by
-your server.
-
-=cut
-
-Set($Timezone, "US/Eastern");
-
-=item C<@Plugins>
-
-Set C<@Plugins> to a list of external RT plugins that should be
-enabled (those plugins have to be previously downloaded and
-installed).
-
-Example:
-
-C<Set(@Plugins, (qw(RT::Extension::SLA RT::Authen::ExternalAuth)));>
-
-=cut
-
-Set(@Plugins, (qw(RTx::Calendar
- RT::Extension::MobileUI))); #RTx::Checklist ));
-
-=back
-
-
-
-
-=head1 Database connection
-
-=over 4
-
-=item C<$DatabaseType>
-
-Database driver being used; case matters. Valid types are "mysql",
-"Oracle" and "Pg".
-
-=cut
-
-Set($DatabaseType, "Pg");
-
-=item C<$DatabaseHost>, C<$DatabaseRTHost>
-
-The domain name of your database server. If you're running MySQL and
-on localhost, leave it blank for enhanced performance.
-
-C<DatabaseRTHost> is the fully-qualified hostname of your RT server,
-for use in granting ACL rights on MySQL.
-
-=cut
-
-Set($DatabaseHost, "localhost");
-Set($DatabaseRTHost, "localhost");
-
-=item C<$DatabasePort>
-
-The port that your database server is running on. Ignored unless it's
-a positive integer. It's usually safe to leave this blank; RT will
-choose the correct default.
-
-=cut
-
-Set($DatabasePort, "");
-
-=item C<$DatabaseUser>
-
-The name of the user to connect to the database as.
-
-=cut
-
-Set($DatabaseUser, "freeside");
-
-=item C<$DatabasePassword>
-
-The password the C<$DatabaseUser> should use to access the database.
-
-=cut
-
-Set($DatabasePassword, q{});
-
-=item C<$DatabaseName>
-
-The name of the RT database on your database server. For Oracle, the
-SID and database objects are created in C<$DatabaseUser>'s schema.
-
-=cut
-
-Set($DatabaseName, q{freeside});
-
-=item C<$DatabaseRequireSSL>
-
-If you're using PostgreSQL and have compiled in SSL support, set
-C<$DatabaseRequireSSL> to 1 to turn on SSL communication with the
-database.
-
-=cut
-
-Set($DatabaseRequireSSL, undef);
-
-=back
-
-
-
-
-=head1 Logging
-
-The default is to log anything except debugging information to syslog.
-Check the L<Log::Dispatch> POD for information about how to get things
-by syslog, mail or anything else, get debugging info in the log, etc.
-
-It might generally make sense to send error and higher by email to
-some administrator. If you do this, be careful that this email isn't
-sent to this RT instance. Mail loops will generate a critical log
-message.
-
-=over 4
-
-=item C<$LogToSyslog>, C<$LogToScreen>
-
-The minimum level error that will be logged to the specific device.
-From lowest to highest priority, the levels are:
-
- debug info notice warning error critical alert emergency
-
-Many syslogds are configured to discard or file debug messages away, so
-if you're attempting to debug RT you may need to reconfigure your
-syslogd or use one of the other logging options.
-
-Logging to your screen affects scripts run from the command line as well
-as the STDERR sent to your webserver (so these logs will usually show up
-in your web server's error logs).
-
-=cut
-
-Set($LogToSyslog, "info");
-Set($LogToScreen, "info");
-
-=item C<$LogToFile>, C<$LogDir>, C<$LogToFileNamed>
-
-Logging to a standalone file is also possible. The file needs to both
-exist and be writable by all direct users of the RT API. This generally
-includes the web server and whoever rt-crontool runs as. Note that
-rt-mailgate and the RT CLI go through the webserver, so their users do
-not need to have write permissions to this file. If you expect to have
-multiple users of the direct API, Best Practical recommends using syslog
-instead of direct file logging.
-
-You should set C<$LogToFile> to one of the levels documented above.
-
-=cut
-
-Set($LogToFile, undef);
-Set($LogDir, q{/opt/rt3/var/log});
-Set($LogToFileNamed, "rt.log"); #log to rt.log
-
-=item C<$LogStackTraces>
-
-If set to a log level then logging will include stack traces for
-messages with level equal to or greater than specified.
-
-NOTICE: Stack traces include parameters supplied to functions or
-methods. It is possible for stack trace logging to reveal sensitive
-information such as passwords or ticket content in your logs.
-
-=cut
-
-Set($LogStackTraces, "");
-
-=item C<@LogToSyslogConf>
-
-On Solaris or UnixWare, set to ( socket => 'inet' ). Options here
-override any other options RT passes to L<Log::Dispatch::Syslog>.
-Other interesting flags include facility and logopt. (See the
-L<Log::Dispatch::Syslog> documentation for more information.) (Maybe
-ident too, if you have multiple RT installations.)
-
-=cut
-
-Set(@LogToSyslogConf, ());
-
-=back
-
-
-
-=head1 Incoming mail gateway
-
-=over 4
-
-=item C<$EmailSubjectTagRegex>
-
-This regexp controls what subject tags RT recognizes as its own. If
-you're not dealing with historical C<$rtname> values, or historical
-queue-specific subject tags, you'll likely never have to change this
-configuration.
-
-Be B<very careful> with it. Note that it overrides C<$rtname> for
-subject token matching and that you should use only "non-capturing"
-parenthesis grouping. For example:
-
-C<Set($EmailSubjectTagRegex, qr/(?:example.com|example.org)/i );>
-
-and NOT
-
-C<Set($EmailSubjectTagRegex, qr/(example.com|example.org)/i );>
-
-The setting below would make RT behave exactly as it does without the
-setting enabled.
-
-=cut
-
-# Set($EmailSubjectTagRegex, qr/\Q$rtname\E/i );
-
-=item C<$OwnerEmail>
-
-C<$OwnerEmail> is the address of a human who manages RT. RT will send
-errors generated by the mail gateway to this address. This address
-should I<not> be an address that's managed by your RT instance.
-
-=cut
-
-Set($OwnerEmail, 'root');
-
-=item C<$LoopsToRTOwner>
-
-If C<$LoopsToRTOwner> is defined, RT will send mail that it believes
-might be a loop to C<$OwnerEmail>.
-
-=cut
-
-Set($LoopsToRTOwner, 1);
-
-=item C<$StoreLoops>
-
-If C<$StoreLoops> is defined, RT will record messages that it believes
-to be part of mail loops. As it does this, it will try to be careful
-not to send mail to the sender of these messages.
-
-=cut
-
-Set($StoreLoops, undef);
-
-=item C<$MaxAttachmentSize>
-
-C<$MaxAttachmentSize> sets the maximum size (in bytes) of attachments
-stored in the database. This setting is irrelevant unless one of
-$TruncateLongAttachments or $DropLongAttachments (below) are set.
-
-=cut
-
-Set($MaxAttachmentSize, 10_000_000);
-
-=item C<$TruncateLongAttachments>
-
-If this is set to a non-undef value, RT will truncate attachments
-longer than C<$MaxAttachmentSize>.
-
-=cut
-
-Set($TruncateLongAttachments, undef);
-
-=item C<$DropLongAttachments>
-
-If this is set to a non-undef value, RT will silently drop attachments
-longer than C<MaxAttachmentSize>. C<$TruncateLongAttachments>, above,
-takes priority over this.
-
-=cut
-
-Set($DropLongAttachments, undef);
-
-=item C<$RTAddressRegexp>
-
-C<$RTAddressRegexp> is used to make sure RT doesn't add itself as a
-ticket CC if C<$ParseNewMessageForTicketCcs>, above, is enabled. It
-is important that you set this to a regular expression that matches
-all addresses used by your RT. This lets RT avoid sending mail to
-itself. It will also hide RT addresses from the list of "One-time Cc"
-and Bcc lists on ticket reply.
-
-If you have a number of addresses configured in your RT database
-already, you can generate a naive first pass regexp by using:
-
- perl etc/upgrade/generate-rtaddressregexp
-
-If left blank, RT will compare each address to your configured
-C<$CorrespondAddress> and C<$CommentAddress> before searching for a
-Queue configured with a matching "Reply Address" or "Comment Address"
-on the Queue Admin page.
-
-=cut
-
-Set($RTAddressRegexp, undef);
-
-=item C<$IgnoreCcRegexp>
-
-C<$IgnoreCcRegexp> is a regexp to exclude addresses from automatic addition
-to the Cc list. Use this for addresses that are I<not> received by RT but
-are sometimes added to Cc lists by mistake. Unlike C<$RTAddressRegexp>,
-these addresses can still receive email from RT otherwise.
-
-=cut
-
-Set($IgnoreCcRegexp, undef);
-
-=item C<$CanonicalizeEmailAddressMatch>, C<$CanonicalizeEmailAddressReplace>
-
-RT provides functionality which allows the system to rewrite incoming
-email addresses. In its simplest form, you can substitute the value
-in C<CanonicalizeEmailAddressReplace> for the value in
-C<CanonicalizeEmailAddressMatch> (These values are passed to the
-C<CanonicalizeEmailAddress> subroutine in F<RT/User.pm>)
-
-By default, that routine performs a C<s/$Match/$Replace/gi> on any
-address passed to it.
-
-=cut
-
-# Set($CanonicalizeEmailAddressMatch, '@subdomain\.example\.com$');
-# Set($CanonicalizeEmailAddressReplace, '@example.com');
-
-=item C<$CanonicalizeOnCreate>
-
-Set this to 1 and the create new user page will use the values that
-you enter in the form but use the function CanonicalizeUserInfo in
-F<RT/User_Local.pm>
-
-=cut
-
-Set($CanonicalizeOnCreate, 0);
-
-=item C<$ValidateUserEmailAddresses>
-
-If C<$ValidateUserEmailAddresses> is 1, RT will refuse to create
-users with an invalid email address (as specified in RFC 2822) or with
-an email address made of multiple email addresses.
-
-=cut
-
-Set($ValidateUserEmailAddresses, undef);
-
-=item C<$NonCustomerEmailRegexp>
-
-Normally, when a ticket is linked to a customer, any requestors on that
-ticket that didn't previously have customer memberships are linked to
-the customer also. C<$NonCustomerEmailRegexp> is a regexp for email
-addresses that should I<not> automatically be linked to a customer in
-this way.
-
-=cut
-
-Set($NonCustomerEmailRegexp, undef);
-
-=item C<@MailPlugins>
-
-C<@MailPlugins> is a list of authentication plugins for
-L<RT::Interface::Email> to use; see L<rt-mailgate>
-
-=cut
-
-=item C<$UnsafeEmailCommands>
-
-C<$UnsafeEmailCommands>, if set to 1, enables 'take' and 'resolve'
-as possible actions via the mail gateway. As its name implies, this
-is very unsafe, as it allows email with a forged sender to possibly
-resolve arbitrary tickets!
-
-=cut
-
-=item C<$ExtractSubjectTagMatch>, C<$ExtractSubjectTagNoMatch>
-
-The default "extract remote tracking tags" scrip settings; these
-detect when your RT is talking to another RT, and adjust the subject
-accordingly.
-
-=cut
-
-Set($ExtractSubjectTagMatch, qr/\[[^\]]+? #\d+\]/);
-Set($ExtractSubjectTagNoMatch, ( ${RT::EmailSubjectTagRegex}
- ? qr/\[(?:${RT::EmailSubjectTagRegex}) #\d+\]/
- : qr/\[\Q$RT::rtname\E #\d+\]/));
-
-=item C<$CheckMoreMSMailHeaders>
-
-Some email clients create a plain text version of HTML-formatted
-email to help other clients that read only plain text.
-Unfortunately, the plain text parts sometimes end up with
-doubled newlines and these can then end up in RT. This
-is most often seen in MS Outlook.
-
-Enable this option to have RT check for additional mail headers
-and attempt to identify email from MS Outlook. When detected,
-RT will then clean up double newlines. Note that it may
-clean up intentional double newlines as well.
-
-=cut
-
-Set( $CheckMoreMSMailHeaders, 0);
-
-=back
-
-
-
-=head1 Outgoing mail
-
-=over 4
-
-=item C<$MailCommand>
-
-C<$MailCommand> defines which method RT will use to try to send mail.
-We know that 'sendmailpipe' works fairly well. If 'sendmailpipe'
-doesn't work well for you, try 'sendmail'. Other options are 'smtp'
-or 'qmail'.
-
-Note that you should remove the '-t' from C<$SendmailArguments> if you
-use 'sendmail' rather than 'sendmailpipe'
-
-For testing purposes, or to simply disable sending mail out into the
-world, you can set C<$MailCommand> to 'testfile' which writes all mail
-to a temporary file. RT will log the location of the temporary file
-so you can extract mail from it afterward.
-
-On shutdown, RT will clean up the temporary file created when using
-the 'testfile' option. If testing while the RT server is still running,
-you can find the files in the location noted in the log file. If you run
-a tool like C<rt-crontool> however, or if you look after stopping the server,
-the files will have been deleted when the process completed. If you need to
-keep the files for development or debugging, you can manually set
-C<< UNLINK => 0 >> where the testfile config is processed in
-F<lib/RT/Interface/Email.pm>.
-
-=cut
-
-#Set($MailCommand, "sendmailpipe");
-Set($MailCommand, "sendmail");
-
-=item C<$SetOutgoingMailFrom>
-
-C<$SetOutgoingMailFrom> tells RT to set the sender envelope to the
-Correspond mail address of the ticket's queue.
-
-Warning: If you use this setting, bounced mails will appear to be
-incoming mail to the system, thus creating new tickets.
-
-If the value contains an C<@>, it is assumed to be an email address and used as
-a global envelope sender. Expected usage in this case is to simply set the
-same envelope sender on all mail from RT, without defining
-C<$OverrideOutgoingMailFrom>. If you do define C<$OverrideOutgoingMailFrom>,
-anything specified there overrides the global value (including Default).
-
-This option only works if C<$MailCommand> is set to 'sendmailpipe'.
-
-=cut
-
-Set($SetOutgoingMailFrom, 0);
-
-=item C<$OverrideOutgoingMailFrom>
-
-C<$OverrideOutgoingMailFrom> is used for overwriting the Correspond
-address of the queue as it is handed to sendmail -f. This helps force
-the From_ header away from www-data or other email addresses that show
-up in the "Sent by" line in Outlook.
-
-The option is a hash reference of queue name to email address. If
-there is no ticket involved, then the value of the C<Default> key will
-be used.
-
-This option only works if C<$SetOutgoingMailFrom> is enabled and
-C<$MailCommand> is set to 'sendmailpipe'.
-
-=cut
-
-Set($OverrideOutgoingMailFrom, {
-# 'Default' => 'admin@rt.example.com',
-# 'General' => 'general@rt.example.com',
-});
-
-=item C<$DefaultMailPrecedence>
-
-C<$DefaultMailPrecedence> is used to control the default Precedence
-level of outgoing mail where none is specified. By default it is
-C<bulk>, but if you only send mail to your staff, you may wish to
-change it.
-
-Note that you can set the precedence of individual templates by
-including an explicit Precedence header.
-
-If you set this value to C<undef> then we do not set a default
-Precedence header to outgoing mail. However, if there already is a
-Precedence header, it will be preserved.
-
-=cut
-
-Set($DefaultMailPrecedence, "bulk");
-
-=item C<$DefaultErrorMailPrecedence>
-
-C<$DefaultErrorMailPrecedence> is used to control the default
-Precedence level of outgoing mail that indicates some kind of error
-condition. By default it is C<bulk>, but if you only send mail to your
-staff, you may wish to change it.
-
-If you set this value to C<undef> then we do not add a Precedence
-header to error mail.
-
-=cut
-
-Set($DefaultErrorMailPrecedence, "bulk");
-
-=item C<$UseOriginatorHeader>
-
-C<$UseOriginatorHeader> is used to control the insertion of an
-RT-Originator Header in every outgoing mail, containing the mail
-address of the transaction creator.
-
-=cut
-
-Set($UseOriginatorHeader, 1);
-
-=item C<$UseFriendlyFromLine>
-
-By default, RT sets the outgoing mail's "From:" header to "SenderName
-via RT". Setting C<$UseFriendlyFromLine> to 0 disables it.
-
-=cut
-
-Set($UseFriendlyFromLine, 1);
-
-=item C<$FriendlyFromLineFormat>
-
-C<sprintf()> format of the friendly 'From:' header; its arguments are
-SenderName and SenderEmailAddress.
-
-=cut
-
-Set($FriendlyFromLineFormat, "\"%s via RT\" <%s>");
-
-=item C<$UseFriendlyToLine>
-
-RT can optionally set a "Friendly" 'To:' header when sending messages
-to Ccs or AdminCcs (rather than having a blank 'To:' header.
-
-This feature DOES NOT WORK WITH SENDMAIL[tm] BRAND SENDMAIL. If you
-are using sendmail, rather than postfix, qmail, exim or some other
-MTA, you _must_ disable this option.
-
-=cut
-
-Set($UseFriendlyToLine, 0);
-
-=item C<$FriendlyToLineFormat>
-
-C<sprintf()> format of the friendly 'To:' header; its arguments are
-WatcherType and TicketId.
-
-=cut
-
-Set($FriendlyToLineFormat, "\"%s of ". RT->Config->Get('rtname') ." Ticket #%s\":;");
-
-=item C<$NotifyActor>
-
-By default, RT doesn't notify the person who performs an update, as
-they already know what they've done. If you'd like to change this
-behavior, Set C<$NotifyActor> to 1
-
-=cut
-
-Set($NotifyActor, 0);
-
-=item C<$RecordOutgoingEmail>
-
-By default, RT records each message it sends out to its own internal
-database. To change this behavior, set C<$RecordOutgoingEmail> to 0
-
-If this is disabled, users' digest mail delivery preferences
-(i.e. EmailFrequency) will also be ignored.
-
-=cut
-
-Set($RecordOutgoingEmail, 1);
-
-=item C<$VERPPrefix>, C<$VERPDomain>
-
-Setting these options enables VERP support
-L<http://cr.yp.to/proto/verp.txt>.
-
-Uncomment the following two directives to generate envelope senders
-of the form C<${VERPPrefix}${originaladdress}@${VERPDomain}>
-(i.e. rt-jesse=fsck.com@rt.example.com ).
-
-This currently only works with sendmail and sendmailpipe.
-
-=cut
-
-# Set($VERPPrefix, "rt-");
-# Set($VERPDomain, $RT::Organization);
-
-
-=item C<$ForwardFromUser>
-
-By default, RT forwards a message using queue's address and adds RT's
-tag into subject of the outgoing message, so recipients' replies go
-into RT as correspondents.
-
-To change this behavior, set C<$ForwardFromUser> to 1 and RT
-will use the address of the current user and remove RT's subject tag.
-
-=cut
-
-Set($ForwardFromUser, 0);
-
-=back
-
-=head2 Email dashboards
-
-=over 4
-
-=item C<$DashboardAddress>
-
-The email address from which RT will send dashboards. If none is set,
-then C<$OwnerEmail> will be used.
-
-=cut
-
-Set($DashboardAddress, '');
-
-=item C<$DashboardSubject>
-
-Lets you set the subject of dashboards. Arguments are the frequency (Daily,
-Weekly, Monthly) of the dashboard and the dashboard's name.
-
-=cut
-
-Set($DashboardSubject, "%s Dashboard: %s");
-
-=item C<@EmailDashboardRemove>
-
-A list of regular expressions that will be used to remove content from
-mailed dashboards.
-
-=cut
-
-Set(@EmailDashboardRemove, ());
-
-=back
-
-
-
-=head2 Sendmail configuration
-
-These options only take effect if C<$MailCommand> is 'sendmail' or
-'sendmailpipe'
-
-=over 4
-
-=item C<$SendmailArguments>
-
-C<$SendmailArguments> defines what flags to pass to C<$SendmailPath>
-If you picked 'sendmailpipe', you MUST add a -t flag to
-C<$SendmailArguments> These options are good for most sendmail
-wrappers and work-a-likes.
-
-These arguments are good for sendmail brand sendmail 8 and newer:
-C<Set($SendmailArguments,"-oi -t -ODeliveryMode=b -OErrorMode=m");>
-
-=cut
-
-#Set($SendmailArguments, "-oi -t");
-Set($SendmailArguments, "-oi");
-
-
-=item C<$SendmailBounceArguments>
-
-C<$SendmailBounceArguments> defines what flags to pass to C<$Sendmail>
-assuming RT needs to send an error (i.e. bounce).
-
-=cut
-
-Set($SendmailBounceArguments, '-f "<>"');
-
-=item C<$SendmailPath>
-
-If you selected 'sendmailpipe' above, you MUST specify the path to
-your sendmail binary in C<$SendmailPath>.
-
-=cut
-
-Set($SendmailPath, "/usr/sbin/sendmail");
-
-
-=back
-
-=head2 SMTP configuration
-
-These options only take effect if C<$MailCommand> is 'smtp'
-
-=over 4
-
-=item C<$SMTPServer>
-
-C<$SMTPServer> should be set to the hostname of the SMTP server to use
-
-=cut
-
-Set($SMTPServer, undef);
-
-=item C<$SMTPFrom>
-
-C<$SMTPFrom> should be set to the 'From' address to use, if not the
-email's 'From'
-
-=cut
-
-Set($SMTPFrom, undef);
-
-=item C<$SMTPDebug>
-
-C<$SMTPDebug> should be set to 1 to debug SMTP mail sending
-
-=cut
-
-Set($SMTPDebug, 0);
-
-=back
-
-=head2 Other mailers
-
-=over 4
-
-=item C<@MailParams>
-
-C<@MailParams> defines a list of options passed to $MailCommand if it
-is not 'sendmailpipe', 'sendmail', or 'smtp'
-
-=cut
-
-Set(@MailParams, ());
-
-=back
-
-
-=head1 Web interface
-
-=over 4
-
-=item C<$WebDefaultStylesheet>
-
-This determines the default stylesheet the RT web interface will use.
-RT ships with several themes by default:
-
- web2 The default layout for RT 3.8
- aileron The default layout for RT 4.0
- ballard Theme which doesn't rely on JavaScript for menuing
-
-This bundled distibution of RT also includes:
- freeside3 Integration with Freeside (enabled by default)
- freeside2.1 Previous Freeside theme
-
-This value actually specifies a directory in F<share/html/NoAuth/css/>
-from which RT will try to load the file main.css (which should @import
-any other files the stylesheet needs). This allows you to easily and
-cleanly create your own stylesheets to apply to RT. This option can
-be overridden by users in their preferences.
-
-=cut
-
-Set($WebDefaultStylesheet, "freeside3");
-
-=item C<$DefaultQueue>
-
-Use this to select the default queue name that will be used for
-creating new tickets. You may use either the queue's name or its
-ID. This only affects the queue selection boxes on the web interface.
-
-=cut
-
-# Set($DefaultQueue, "General");
-
-=item C<$RememberDefaultQueue>
-
-When a queue is selected in the new ticket dropdown, make it the new
-default for the new ticket dropdown.
-
-=cut
-
-# Set($RememberDefaultQueue, 1);
-
-=item C<$EnableReminders>
-
-Hide all links and portlets related to Reminders by setting this to 0
-
-=cut
-
-Set($EnableReminders, 1);
-
-=item C<@CustomFieldValuesSources>
-
-Set C<@CustomFieldValuesSources> to a list of class names which extend
-L<RT::CustomFieldValues::External>. This can be used to pull lists of
-custom field values from external sources at runtime.
-
-=cut
-
-Set(@CustomFieldValuesSources, ('RT::CustomFieldValues::Queues'));
-
-=item C<$CanonicalizeRedirectURLs>
-
-Set C<$CanonicalizeRedirectURLs> to 1 to use C<$WebURL> when
-redirecting rather than the one we get from C<%ENV>.
-
-Apache's UseCanonicalName directive changes the hostname that RT
-finds in C<%ENV>. You can read more about what turning it On or Off
-means in the documentation for your version of Apache.
-
-If you use RT behind a reverse proxy, you almost certainly want to
-enable this option.
-
-=cut
-
-Set($CanonicalizeRedirectURLs, 0);
-
-=item C<@JSFiles>
-
-A list of JavaScript files to be included in head. Removing any of
-the default entries is not suggested.
-
-If you're a plugin author, refer to RT->AddJavaScript.
-
-=cut
-
-Set(@JSFiles, qw/
- jquery-1.4.2.min.js
- jquery_noconflict.js
- jquery-ui-1.8.4.custom.min.js
- jquery-ui-timepicker-addon.js
- jquery-ui-patch-datepicker.js
- jquery.cookie.js
- titlebox-state.js
- util.js
- userautocomplete.js
- jquery.event.hover-1.0.js
- superfish.js
- supersubs.js
- jquery.supposition.js
- history-folding.js
- late.js
-/);
-
-=item C<$JSMinPath>
-
-Path to the jsmin binary; if specified, it will be used to minify
-C<JSFiles>. The default, and the fallback if the binary cannot be
-found, is to simply concatenate the files.
-
-jsmin can be installed by running 'make jsmin' from the RT install
-directory, or from http://www.crockford.com/javascript/jsmin.html
-
-=cut
-
-# Set($JSMinPath, "/path/to/jsmin");
-
-=item C<@CSSFiles>
-
-A list of additional CSS files to be included in head.
-
-If you're a plugin author, refer to RT->AddStyleSheets.
-
-=cut
-
-Set(@CSSFiles, qw//);
-
-=item C<$UsernameFormat>
-
-This determines how user info is displayed. 'concise' will show one of
-either NickName, RealName, Name or EmailAddress, depending on what
-exists and whether the user is privileged or not. 'verbose' will show
-RealName and EmailAddress.
-
-=cut
-
-Set($UsernameFormat, "verbose");
-
-=item C<$WebBaseURL>, C<$WebURL>
-
-Usually you don't want to set these options. The only obvious reason
-is if RT is accessible via https protocol on a non standard port, e.g.
-'https://rt.example.com:9999'. In all other cases these options are
-computed using C<$WebDomain>, C<$WebPort> and C<$WebPath>.
-
-C<$WebBaseURL> is the scheme, server and port
-(e.g. 'http://rt.example.com') for constructing URLs to the web
-UI. C<$WebBaseURL> doesn't need a trailing /.
-
-C<$WebURL> is the C<$WebBaseURL>, C<$WebPath> and trailing /, for
-example: 'http://www.example.com/rt/'.
-
-=cut
-
-my $port = RT->Config->Get('WebPort');
-Set($WebBaseURL,
- ($port == 443? 'https': 'http') .'://'
- . RT->Config->Get('WebDomain')
- . ($port != 80 && $port != 443? ":$port" : '')
-);
-
-Set($WebURL, RT->Config->Get('WebBaseURL') . RT->Config->Get('WebPath') . "/");
-
-=item C<$WebImagesURL>
-
-C<$WebImagesURL> points to the base URL where RT can find its images.
-Define the directory name to be used for images in RT web documents.
-
-=cut
-
-Set($WebImagesURL, RT->Config->Get('WebPath') . "/NoAuth/images/");
-
-=item C<$LogoURL>
-
-C<$LogoURL> points to the URL of the RT logo displayed in the web UI.
-This can also be configured via the web UI.
-
-=cut
-
-Set($LogoURL, RT->Config->Get('WebImagesURL') . "bpslogo.png");
-
-=item C<$LogoLinkURL>
-
-C<$LogoLinkURL> is the URL that the RT logo hyperlinks to.
-
-=cut
-
-Set($LogoLinkURL, "http://bestpractical.com");
-
-=item C<$LogoAltText>
-
-C<$LogoAltText> is a string of text for the alt-text of the logo. It
-will be passed through C<loc> for localization.
-
-=cut
-
-Set($LogoAltText, "Best Practical Solutions, LLC corporate logo");
-
-=item C<$LogoImageHeight>
-
-C<$LogoImageHeight> is the value of the C<height> attribute of the logo
-C<img> tag.
-
-=cut
-
-Set($LogoImageHeight, 38);
-
-=item C<$LogoImageWidth>
-
-C<$LogoImageWidth> is the value of the C<width> attribute of the logo
-C<img> tag.
-
-=cut
-
-Set($LogoImageWidth, 181);
-
-=item C<$WebNoAuthRegex>
-
-What portion of RT's URL space should not require authentication. The
-default is almost certainly correct, and should only be changed if you
-are extending RT.
-
-=cut
-
-Set($WebNoAuthRegex, qr{^ /rt (?:/+NoAuth/ | /+REST/\d+\.\d+/NoAuth/) }x );
-
-=item C<$SelfServiceRegex>
-
-What portion of RT's URLspace should be accessible to Unprivileged
-users This does not override the redirect from F</Ticket/Display.html>
-to F</SelfService/Display.html> when Unprivileged users attempt to
-access ticked displays.
-
-=cut
-
-Set($SelfServiceRegex, qr!^(?:/+SelfService/)!x );
-
-=item C<$WebFlushDbCacheEveryRequest>
-
-By default, RT clears its database cache after every page view. This
-ensures that you've always got the most current information when
-working in a multi-process (mod_perl or FastCGI) Environment. Setting
-C<$WebFlushDbCacheEveryRequest> to 0 will turn this off, which will
-speed RT up a bit, at the expense of a tiny bit of data accuracy.
-
-=cut
-
-Set($WebFlushDbCacheEveryRequest, 1);
-
-=item C<%ChartFont>
-
-The L<GD> module (which RT uses for graphs) ships with a built-in font
-that doesn't have full Unicode support. You can use a given TrueType
-font for a specific language by setting %ChartFont to (language =E<gt>
-the absolute path of a font) pairs. Your GD library must have support
-for TrueType fonts to use this option. If there is no entry for a
-language in the hash then font with 'others' key is used.
-
-RT comes with two TrueType fonts covering most available languages.
-
-=cut
-
-Set(
- %ChartFont,
- 'zh-cn' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf",
- 'zh-tw' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf",
- 'ja' => "$RT::BasePath/share/fonts/DroidSansFallback.ttf",
- 'others' => "$RT::BasePath/share/fonts/DroidSans.ttf",
-);
-
-=item C<$ChartsTimezonesInDB>
-
-RT stores dates using the UTC timezone in the DB, so charts grouped by
-dates and time are not representative. Set C<$ChartsTimezonesInDB> to 1
-to enable timezone conversions using your DB's capabilities. You may
-need to do some work on the DB side to use this feature, read more in
-F<docs/customizing/timezones_in_charts.pod>.
-
-At this time, this feature only applies to MySQL and PostgreSQL.
-
-=cut
-
-Set($ChartsTimezonesInDB, 0);
-
-=back
-
-
-
-=head2 Home page
-
-=over 4
-
-=item C<$DefaultSummaryRows>
-
-C<$DefaultSummaryRows> is default number of rows displayed in for
-search results on the front page.
-
-=cut
-
-Set($DefaultSummaryRows, 10);
-
-=item C<$HomePageRefreshInterval>
-
-C<$HomePageRefreshInterval> is default number of seconds to refresh
-the RT home page. Choose from [0, 120, 300, 600, 1200, 3600, 7200].
-
-=cut
-
-Set($HomePageRefreshInterval, 0);
-
-=item C<$HomepageComponents>
-
-C<$HomepageComponents> is an arrayref of allowed components on a
-user's customized homepage ("RT at a glance").
-
-=cut
-
-Set(
- $HomepageComponents,
- [
- qw(QuickCreate Quicksearch MyCalendar MyAdminQueues MySupportQueues MyReminders RefreshHomepage Dashboards SavedSearches ) # loc_qw
- ]
-);
-
-=back
-
-
-
-
-=head2 Ticket search
-
-=over 4
-
-=item C<$UseSQLForACLChecks>
-
-Historically, ACLs were checked on display, which could lead to empty
-search pages and wrong ticket counts. Set C<$UseSQLForACLChecks> to 1
-to limit search results in SQL instead, which eliminates these
-problems.
-
-This option is still relatively new; it may result in performance
-problems in some cases, or significant speedups in others.
-
-=cut
-
-Set($UseSQLForACLChecks, undef);
-
-=item C<$TicketsItemMapSize>
-
-On the display page of a ticket from search results, RT provides links
-to the first, next, previous and last ticket from the results. In
-order to build these links, RT needs to fetch the full result set from
-the database, which can be resource-intensive.
-
-Set C<$TicketsItemMapSize> to number of tickets you want RT to examine
-to build these links. If the full result set is larger than this
-number, RT will omit the "last" link in the menu. Set this to zero to
-always examine all results.
-
-=cut
-
-Set($TicketsItemMapSize, 1000);
-
-=item C<$SearchResultsRefreshInterval>
-
-C<$SearchResultsRefreshInterval> is default number of seconds to
-refresh search results in RT. Choose from [0, 120, 300, 600, 1200,
-3600, 7200].
-
-=cut
-
-Set($SearchResultsRefreshInterval, 0);
-
-=item C<$DefaultSearchResultFormat>
-
-C<$DefaultSearchResultFormat> is the default format for RT search
-results
-
-=cut
-
-Set ($DefaultSearchResultFormat, qq{
- '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__id__</a></B>/TITLE:#',
- '<B><A HREF="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject',
- Customer,
- Status,
- QueueName,
- OwnerName,
- Priority,
- '__NEWLINE__',
- '__NBSP__',
- '<small>__Requestors__</small>',
- '<small>__CustomerTags__</small>',
- '<small>__CreatedRelative__</small>',
- '<small>__ToldRelative__</small>',
- '<small>__LastUpdatedRelative__</small>',
- '<small>__TimeLeft__</small>'});
-
-=item C<$DefaultSelfServiceSearchResultFormat>
-
-C<$DefaultSelfServiceSearchResultFormat> is the default format of
-searches displayed in the SelfService interface.
-
-=cut
-
-Set($DefaultSelfServiceSearchResultFormat, qq{
- '<B><A HREF="__WebPath__/SelfService/Display.html?id=__id__">__id__</a></B>/TITLE:#',
- '<B><A HREF="__WebPath__/SelfService/Display.html?id=__id__">__Subject__</a></B>/TITLE:Subject',
- Status,
- Requestors,
- OwnerName});
-
-=item C<%FullTextSearch>
-
-Full text search (FTS) without database indexing is a very slow
-operation, and is thus disabled by default.
-
-Before setting C<Indexed> to 1, read F<docs/full_text_indexing.pod> for
-the full details of FTS on your particular database.
-
-It is possible to enable FTS without database indexing support, simply
-by setting the C<Enable> key to 1, while leaving C<Indexed> set to 0.
-This is not generally suggested, as unindexed full-text searching can
-cause severe performance problems.
-
-=cut
-
-Set(%FullTextSearch,
- Enable => 0,
- Indexed => 0,
-);
-
-=item C<$DontSearchFileAttachments>
-
-If C<$DontSearchFileAttachments> is set to 1, then uploaded files
-(attachments with file names) are not searched during content
-search.
-
-Note that if you use indexed FTS then named attachments are still
-indexed by default regardless of this option.
-
-=cut
-
-Set($DontSearchFileAttachments, undef);
-
-=item C<$OnlySearchActiveTicketsInSimpleSearch>
-
-When query in simple search doesn't have status info, use this to only
-search active ones.
-
-=cut
-
-Set($OnlySearchActiveTicketsInSimpleSearch, 1);
-
-=item C<$SearchResultsAutoRedirect>
-
-When only one ticket is found in search, use this to redirect to the
-ticket display page automatically.
-
-=cut
-
-Set($SearchResultsAutoRedirect, 0);
-
-=back
-
-
-
-=head2 Ticket display
-
-=over 4
-
-=item C<$ShowMoreAboutPrivilegedUsers>
-
-This determines if the 'More about requestor' box on
-Ticket/Display.html is shown for Privileged Users.
-
-=cut
-
-Set($ShowMoreAboutPrivilegedUsers, 0);
-
-=item C<$MoreAboutRequestorTicketList>
-
-This can be set to Active, Inactive, All or None. It controls what
-ticket list will be displayed in the 'More about requestor' box on
-Ticket/Display.html. This option can be controlled by users also.
-
-=cut
-
-Set($MoreAboutRequestorTicketList, "Active");
-
-=item C<$MoreAboutRequestorExtraInfo>
-
-By default, the 'More about requestor' box on Ticket/Display.html
-shows the Requestor's name and ticket list. If you would like to see
-extra information about the user, this expects a Format string of user
-attributes. Please note that not all the attributes are supported in
-this display because we're not building a table.
-
-Example:
-C<Set($MoreAboutRequestorExtraInfo,"Organization, Address1")>
-
-=cut
-
-Set($MoreAboutRequestorExtraInfo, "");
-
-=item C<$MoreAboutRequestorGroupsLimit>
-
-By default, the 'More about requestor' box on Ticket/Display.html
-shows all the groups of the Requestor. Use this to limit the number
-of groups; a value of undef removes the group display entirely.
-
-=cut
-
-Set($MoreAboutRequestorGroupsLimit, 0);
-
-=item C<$UseSideBySideLayout>
-
-Should the ticket create and update forms use a more space efficient
-two column layout. This layout may not work in narrow browsers if you
-set a MessageBoxWidth (below).
-
-=cut
-
-Set($UseSideBySideLayout, 1);
-
-=item C<$EditCustomFieldsSingleColumn>
-
-When displaying a list of Ticket Custom Fields for editing, RT
-defaults to a 2 column list. If you set this to 1, it will instead
-display the Custom Fields in a single column.
-
-=cut
-
-Set($EditCustomFieldsSingleColumn, 0);
-
-=item C<$ShowUnreadMessageNotifications>
-
-If set to 1, RT will prompt users when there are new,
-unread messages on tickets they are viewing.
-
-=cut
-
-Set($ShowUnreadMessageNotifications, 0);
-
-=item C<$AutocompleteOwners>
-
-If set to 1, the owner drop-downs for ticket update/modify and the query
-builder are replaced by text fields that autocomplete. This can
-alleviate the sometimes huge owner list for installations where many
-users have the OwnTicket right.
-
-=cut
-
-Set($AutocompleteOwners, 0);
-
-=item C<$AutocompleteOwnersForSearch>
-
-If set to 1, the owner drop-downs for the query builder are always
-replaced by text field that autocomplete and C<$AutocompleteOwners>
-is ignored. Helpful when owners list is huge in the query builder.
-
-=cut
-
-Set($AutocompleteOwnersForSearch, 0);
-
-=item C<$UserAutocompleteFields>
-
-Specifies which fields of L<RT::User> to match against and how to
-match each field when autocompleting users. Valid match methods are
-LIKE, STARTSWITH, ENDSWITH, =, and !=.
-
-=cut
-
-Set($UserAutocompleteFields, {
- EmailAddress => 'STARTSWITH',
- Name => 'STARTSWITH',
- RealName => 'LIKE',
-});
-
-=item C<$AllowUserAutocompleteForUnprivileged>
-
-Should unprivileged users be allowed to autocomplete users. Setting
-this option to 1 means unprivileged users will be able to search all
-your users.
-
-=cut
-
-Set($AllowUserAutocompleteForUnprivileged, 0);
-
-=item C<$DisplayTicketAfterQuickCreate>
-
-Enable this to redirect to the created ticket display page
-automatically when using QuickCreate.
-
-=cut
-
-Set($DisplayTicketAfterQuickCreate, 0);
-
-=item C<$WikiImplicitLinks>
-
-Support implicit links in WikiText custom fields? Setting this to 1
-causes InterCapped or ALLCAPS words in WikiText fields to automatically
-become links to searches for those words. If used on Articles, it links
-to the Article with that name.
-
-=cut
-
-Set($WikiImplicitLinks, 0);
-
-=item C<$PreviewScripMessages>
-
-Set C<$PreviewScripMessages> to 1 if the scrips preview on the ticket
-reply page should include the content of the messages to be sent.
-
-=cut
-
-Set($PreviewScripMessages, 0);
-
-=item C<$SimplifiedRecipients>
-
-If C<$SimplifiedRecipients> is set, a simple list of who will receive
-B<any> kind of mail will be shown on the ticket reply page, instead of a
-detailed breakdown by scrip.
-
-=cut
-
-Set($SimplifiedRecipients, 0);
-
-=item C<$HideResolveActionsWithDependencies>
-
-If set to 1, this option will skip ticket menu actions which can't be
-completed successfully because of outstanding active Depends On tickets.
-
-By default, all ticket actions are displayed in the menu even if some of
-them can't be successful until all Depends On links are resolved or
-transitioned to another inactive status.
-
-=cut
-
-Set($HideResolveActionsWithDependencies, 0);
-
-=back
-
-
-
-=head2 Articles
-
-=over 4
-
-=item C<$ArticleOnTicketCreate>
-
-Set this to 1 to display the Articles interface on the Ticket Create
-page in addition to the Reply/Comment page.
-
-=cut
-
-Set($ArticleOnTicketCreate, 0);
-
-=item C<$HideArticleSearchOnReplyCreate>
-
-Set this to 1 to hide the search and include boxes from the Article
-UI. This assumes you have enabled Article Hotlist feature, otherwise
-you will have no access to Articles.
-
-=cut
-
-Set($HideArticleSearchOnReplyCreate, 0);
-
-=back
-
-
-
-=head2 Message box properties
-
-=over 4
-
-=item C<$MessageBoxWidth>, C<$MessageBoxHeight>
-
-For message boxes, set the entry box width, height and what type of
-wrapping to use. These options can be overridden by users in their
-preferences.
-
-When the width is set to undef, no column count is specified and the
-message box will take up 100% of the available width. Combining this
-with HARD messagebox wrapping (below) is not recommended, as it will
-lead to inconsistent width in transactions between browsers.
-
-These settings only apply to the non-RichText message box. See below
-for Rich Text settings.
-
-=cut
-
-Set($MessageBoxWidth, undef);
-Set($MessageBoxHeight, 15);
-
-=item C<$MessageBoxWrap>
-
-Wrapping is disabled when using MessageBoxRichText because of a bad
-interaction between IE and wrapping with the Rich Text Editor.
-
-=cut
-
-Set($MessageBoxWrap, "SOFT");
-
-=item C<$MessageBoxRichText>
-
-Should "rich text" editing be enabled? This option lets your users
-send HTML email messages from the web interface.
-
-=cut
-
-Set($MessageBoxRichText, 1);
-
-=item C<$MessageBoxRichTextHeight>
-
-Height of rich text JavaScript enabled editing boxes (in pixels)
-
-=cut
-
-Set($MessageBoxRichTextHeight, 200);
-
-=item C<$MessageBoxIncludeSignature>
-
-Should your users' signatures (from their Preferences page) be
-included in Comments and Replies.
-
-=cut
-
-Set($MessageBoxIncludeSignature, 1);
-
-=item C<$MessageBoxIncludeSignatureOnComment>
-
-Should your users' signatures (from their Preferences page) be
-included in Comments. Setting this to false overrides
-C<$MessageBoxIncludeSignature>.
-
-=cut
-
-Set($MessageBoxIncludeSignatureOnComment, 1);
-
-=back
-
-
-=head2 Transaction display
-
-=over 4
-
-=item C<$OldestTransactionsFirst>
-
-By default, RT shows newest transactions at the bottom of the ticket
-history page, if you want see them at the top set this to 0. This
-option can be overridden by users in their preferences.
-
-=cut
-
-Set($OldestTransactionsFirst, 1);
-
-=item C<$DeferTransactionLoading>
-
-When set, defers loading ticket history until the user clicks a link.
-This should end up serving pages to users quicker, since generating
-all the HTML for transaction history can be slow for long tickets.
-
-=cut
-
-# Set($DeferTransactionLoading, 1);
-
-=item C<$ShowBccHeader>
-
-By default, RT hides from the web UI information about blind copies
-user sent on reply or comment.
-
-=cut
-
-Set($ShowBccHeader, 0);
-
-=item C<$TrustHTMLAttachments>
-
-If C<TrustHTMLAttachments> is not defined, we will display them as
-text. This prevents malicious HTML and JavaScript from being sent in a
-request (although there is probably more to it than that)
-
-=cut
-
-Set($TrustHTMLAttachments, undef);
-
-=item C<$AlwaysDownloadAttachments>
-
-Always download attachments, regardless of content type. If set, this
-overrides C<TrustHTMLAttachments>.
-
-=cut
-
-Set($AlwaysDownloadAttachments, undef);
-
-=item C<$AttachmentUnits>
-
-Controls the units (kilobytes or bytes) that attachment sizes use for
-display. The default is to display kilobytes if the attachment is
-larger than 1024 bytes, bytes otherwise. If you set
-C<$AttachmentUnits> to C<'k'> then attachment sizes will always be
-displayed in kilobytes. If set to C<'b'>, then sizes will be bytes.
-
-=cut
-
-Set($AttachmentUnits, undef);
-
-=item C<$PreferRichText>
-
-If C<$PreferRichText> is set to 1, RT will show HTML/Rich text messages
-in preference to their plain-text alternatives. RT "scrubs" the HTML to
-show only a minimal subset of HTML to avoid possible contamination by
-cross-site-scripting attacks.
-
-=cut
-
-Set($PreferRichText, undef);
-
-=item C<$MaxInlineBody>
-
-C<$MaxInlineBody> is the maximum attachment size that we want to see
-inline when viewing a transaction. RT will inline any text if the
-value is undefined or 0. This option can be overridden by users in
-their preferences.
-
-=cut
-
-Set($MaxInlineBody, 12000);
-
-=item C<$ShowTransactionImages>
-
-By default, RT shows images attached to incoming (and outgoing) ticket
-updates inline. Set this variable to 0 if you'd like to disable that
-behavior.
-
-=cut
-
-Set($ShowTransactionImages, 1);
-
-=item C<$PlainTextPre>
-
-Normally plaintext attachments are displayed as HTML with line breaks
-preserved. This causes space- and tab-based formatting not to be
-displayed correctly. By setting $PlainTextPre messages will be
-displayed using <pre>.
-
-=cut
-
-Set($PlainTextPre, 0);
-
-
-=item C<$PlainTextMono>
-
-Set C<$PlainTextMono> to 1 to use monospaced font and preserve
-formatting; unlike C<$PlainTextPre>, the text will wrap to fit width
-of the browser window; this option overrides C<$PlainTextPre>.
-
-=cut
-
-Set($PlainTextMono, 0);
-
-=item C<$SuppressInlineTextFiles>
-
-If C<$SuppressInlineTextFiles> is set to 1, then uploaded text files
-(text-type attachments with file names) are prevented from being
-displayed in-line when viewing a ticket's history.
-
-=cut
-
-Set($SuppressInlineTextFiles, undef);
-
-
-=item C<@Active_MakeClicky>
-
-MakeClicky detects various formats of data in headers and email
-messages, and extends them with supporting links. By default, RT
-provides two formats:
-
-* 'httpurl': detects http:// and https:// URLs and adds '[Open URL]'
- link after the URL.
-
-* 'httpurl_overwrite': also detects URLs as 'httpurl' format, but
- replaces the URL with a link.
-
-See F<share/html/Elements/MakeClicky> for documentation on how to add
-your own styles of link detection.
-
-=cut
-
-Set(@Active_MakeClicky, qw());
-
-=back
-
-
-
-=head1 Application logic
-
-=over 4
-
-=item C<$ParseNewMessageForTicketCcs>
-
-If C<$ParseNewMessageForTicketCcs> is set to 1, RT will attempt to
-divine Ticket 'Cc' watchers from the To and Cc lines of incoming
-messages that create new Tickets. This option does not apply to replies
-or comments on existing Tickets. Be forewarned that if you have I<any>
-addresses which forward mail to RT automatically and you enable this
-option without modifying C<$RTAddressRegexp> below, you will get
-yourself into a heap of trouble.
-
-=cut
-
-Set($ParseNewMessageForTicketCcs, undef);
-
-=item C<$UseTransactionBatch>
-
-Set C<$UseTransactionBatch> to 1 to execute transactions in batches,
-such that a resolve and comment (for example) would happen
-simultaneously, instead of as two transactions, unaware of each
-others' existence.
-
-=cut
-
-Set($UseTransactionBatch, 1);
-
-=item C<$StrictLinkACL>
-
-When this feature is enabled a user needs I<ModifyTicket> rights on
-both tickets to link them together; otherwise, I<ModifyTicket> rights
-on either of them is sufficient.
-
-=cut
-
-Set($StrictLinkACL, 1);
-
-=item C<$RedistributeAutoGeneratedMessages>
-
-Should RT redistribute correspondence that it identifies as machine
-generated? A 1 will do so; setting this to 0 will cause no
-such messages to be redistributed. You can also use 'privileged' (the
-default), which will redistribute only to privileged users. This helps
-to protect against malformed bounces and loops caused by auto-created
-requestors with bogus addresses.
-
-=cut
-
-Set($RedistributeAutoGeneratedMessages, "privileged");
-
-=item C<$ApprovalRejectionNotes>
-
-Should rejection notes from approvals be sent to the requestors?
-
-=cut
-
-Set($ApprovalRejectionNotes, 1);
-
-=item C<$ForceApprovalsView>
-
-Should approval tickets only be viewed and modified through the standard
-approval interface? Changing this setting to 1 will redirect any attempt to
-use the normal ticket display and modify page for approval tickets.
-
-For example, with this option set to 1 and an approval ticket #123:
-
- /Ticket/Display.html?id=123
-
-is redirected to
-
- /Approval/Display.html?id=123
-
-=back
-
-=cut
-
-Set($ForceApprovalsView, 0);
-
-=head1 Extra security
-
-This is a list of extra security measures to enable that help keep your RT
-safe. If you don't know what these mean, you should almost certainly leave the
-defaults alone.
-
-=over 4
-
-=item C<$DisallowExecuteCode>
-
-If set to a true value, the C<ExecuteCode> right will be removed from
-all users, B<including> the superuser. This is intended for when RT is
-installed into a shared environment where even the superuser should not
-be allowed to run arbitrary Perl code on the server via scrips.
-
-=cut
-
-Set($DisallowExecuteCode, 0);
-
-=item C<$Framebusting>
-
-If set to a false value, framekiller javascript will be disabled and the
-X-Frame-Options: DENY header will be suppressed from all responses.
-This disables RT's clickjacking protection.
-
-=cut
-
-Set($Framebusting, 1);
-
-=item C<$RestrictReferrer>
-
-If set to a false value, the HTTP C<Referer> (sic) header will not be
-checked to ensure that requests come from RT's own domain. As RT allows
-for GET requests to alter state, disabling this opens RT up to
-cross-site request forgery (CSRF) attacks.
-
-=cut
-
-Set($RestrictReferrer, 1);
-
-=item C<$RestrictLoginReferrer>
-
-If set to a false value, RT will allow the user to log in from any link
-or request, merely by passing in C<user> and C<pass> parameters; setting
-it to a true value forces all logins to come from the login box, so the
-user is aware that they are being logged in. The default is off, for
-backwards compatability.
-
-=cut
-
-Set($RestrictLoginReferrer, 0);
-
-=item C<@ReferrerWhitelist>
-
-This is a list of hostname:port combinations that RT will treat as being
-part of RT's domain. This is particularly useful if you access RT as
-multiple hostnames or have an external auth system that needs to
-redirect back to RT once authentication is complete.
-
- Set(@ReferrerWhitelist, qw(www.example.com:443 www3.example.com:80));
-
-If the "RT has detected a possible cross-site request forgery" error is triggered
-by a host:port sent by your browser that you believe should be valid, you can copy
-the host:port from the error message into this list.
-
-Simple wildcards, similar to SSL certificates, are allowed. For example:
-
- *.example.com:80 # matches foo.example.com
- # but not example.com
- # or foo.bar.example.com
-
- www*.example.com:80 # matches www3.example.com
- # and www-test.example.com
- # and www.example.com
-
-=cut
-
-Set(@ReferrerWhitelist, qw());
-
-=back
-
-
-
-=head1 Authorization and user configuration
-
-=over 4
-
-=item C<$WebExternalAuth>
-
-If C<$WebExternalAuth> is defined, RT will defer to the environment's
-REMOTE_USER variable.
-
-=cut
-
-Set($WebExternalAuth, undef);
-
-=item C<$WebExternalAuthContinuous>
-
-If C<$WebExternalAuthContinuous> is defined, RT will check for the
-REMOTE_USER on each access. If you would prefer this to only happen
-once (at initial login) set this to a false value. The default
-setting will help ensure that if your external authentication system
-deauthenticates a user, RT notices as soon as possible.
-
-=cut
-
-Set($WebExternalAuthContinuous, 1);
-
-=item C<$WebFallbackToInternalAuth>
-
-If C<$WebFallbackToInternalAuth> is defined, the user is allowed a
-chance of fallback to the login screen, even if REMOTE_USER failed.
-
-=cut
-
-Set($WebFallbackToInternalAuth, undef);
-
-=item C<$WebExternalGecos>
-
-C<$WebExternalGecos> means to match 'gecos' field as the user
-identity); useful with mod_auth_pwcheck and IIS Integrated Windows
-logon.
-
-=cut
-
-Set($WebExternalGecos, undef);
-
-=item C<$WebExternalAuto>
-
-C<$WebExternalAuto> will create users under the same name as
-REMOTE_USER upon login, if it's missing in the Users table.
-
-=cut
-
-Set($WebExternalAuto, undef);
-
-=item C<$AutoCreate>
-
-If C<$WebExternalAuto> is set to 1, C<$AutoCreate> will be passed to
-User's Create method. Use it to set defaults, such as creating
-Unprivileged users with C<{ Privileged => 0 }> This must be a hashref.
-
-=cut
-
-Set($AutoCreate, undef);
-
-=item C<$WebSessionClass>
-
-C<$WebSessionClass> is the class you wish to use for managing sessions.
-It defaults to use your SQL database, except on Oracle, where it
-defaults to files on disk.
-
-=cut
-
-# Set($WebSessionClass, "Apache::Session::File");
-
-=item C<$AutoLogoff>
-
-By default, RT's user sessions persist until a user closes his or her
-browser. With the C<$AutoLogoff> option you can setup session lifetime
-in minutes. A user will be logged out if he or she doesn't send any
-requests to RT for the defined time.
-
-=cut
-
-Set($AutoLogoff, 0);
-
-=item C<$LogoutRefresh>
-
-The number of seconds to wait after logout before sending the user to
-the login page. By default, 1 second, though you may want to increase
-this if you display additional information on the logout page.
-
-=cut
-
-Set($LogoutRefresh, 1);
-
-=item C<$WebSecureCookies>
-
-By default, RT's session cookie isn't marked as "secure". Some web
-browsers will treat secure cookies more carefully than non-secure
-ones, being careful not to write them to disk, only sending them over
-an SSL secured connection, and so on. To enable this behavior, set
-C<$WebSecureCookies> to 1. NOTE: You probably don't want to turn this
-on I<unless> users are only connecting via SSL encrypted HTTPS
-connections.
-
-=cut
-
-Set($WebSecureCookies, 0);
-
-=item C<$WebHttpOnlyCookies>
-
-Default RT's session cookie to not being directly accessible to
-javascript. The content is still sent during regular and AJAX requests,
-and other cookies are unaffected, but the session-id is less
-programmatically accessible to javascript. Turning this off should only
-be necessary in situations with odd client-side authentication
-requirements.
-
-=cut
-
-Set($WebHttpOnlyCookies, 1);
-
-=item C<$MinimumPasswordLength>
-
-C<$MinimumPasswordLength> defines the minimum length for user
-passwords. Setting it to 0 disables this check.
-
-=cut
-
-Set($MinimumPasswordLength, 5);
-
-=back
-
-
-=head1 Internationalization
-
-=over 4
-
-=item C<@LexiconLanguages>
-
-An array that contains languages supported by RT's
-internationalization interface. Defaults to all *.po lexicons;
-setting it to C<qw(en ja)> will make RT bilingual instead of
-multilingual, but will save some memory.
-
-=cut
-
-Set(@LexiconLanguages, qw(*));
-
-=item C<@EmailInputEncodings>
-
-An array that contains default encodings used to guess which charset
-an attachment uses, if it does not specify one explicitly. All
-options must be recognized by L<Encode::Guess>. The first element may
-also be '*', which enables encoding detection using
-L<Encode::Detect::Detector>, if installed.
-
-=cut
-
-Set(@EmailInputEncodings, qw(utf-8 iso-8859-1 us-ascii));
-
-=item C<$EmailOutputEncoding>
-
-The charset for localized email. Must be recognized by Encode.
-
-=cut
-
-Set($EmailOutputEncoding, "utf-8");
-
-=back
-
-
-
-
-
-
-
-=head1 Date and time handling
-
-=over 4
-
-=item C<$DateTimeFormat>
-
-You can choose date and time format. See the "Output formatters"
-section in perldoc F<lib/RT/Date.pm> for more options. This option
-can be overridden by users in their preferences.
-
-Some examples:
-
-C<Set($DateTimeFormat, "LocalizedDateTime");>
-C<Set($DateTimeFormat, { Format => "ISO", Seconds => 0 });>
-C<Set($DateTimeFormat, "RFC2822");>
-C<Set($DateTimeFormat, { Format => "RFC2822", Seconds => 0, DayOfWeek => 0 });>
-
-=cut
-
-Set($DateTimeFormat, "DefaultFormat");
-
-# Next two options are for Time::ParseDate
-
-=item C<$DateDayBeforeMonth>
-
-Set this to 1 if your local date convention looks like "dd/mm/yy"
-instead of "mm/dd/yy". Used only for parsing, not for displaying
-dates.
-
-=cut
-
-Set($DateDayBeforeMonth, 1);
-
-=item C<$AmbiguousDayInPast>, C<$AmbiguousDayInFuture>
-
-Should an unspecified day or year in a date refer to a future or a
-past value? For example, should a date of "Tuesday" default to mean
-the date for next Tuesday or last Tuesday? Should the date "March 1"
-default to the date for next March or last March?
-
-Set C<$AmbiguousDayInPast> for the last date, or
-C<$AmbiguousDayInFuture> for the next date; the default is usually
-correct. If both are set, C<$AmbiguousDayInPast> takes precedence.
-
-=cut
-
-Set($AmbiguousDayInPast, 0);
-Set($AmbiguousDayInFuture, 0);
-
-=item C<$DefaultTimeUnitsToHours>
-
-Use this to set the default units for time entry to hours instead of
-minutes. Note that this only effects entry, not display.
-
-=cut
-
-Set($DefaultTimeUnitsToHours, 0);
-
-=item C<$SimpleSearchIncludeResolved>
-
-By default, the simple ticket search in the top bar excludes "resolved" tickets
-unless a status argument is specified. Set this to a true value to include
-them.
-
-=cut
-
-Set($SimpleSearchIncludeResolved, 0);
-
-=back
-
-
-
-
-=head1 GnuPG integration
-
-A full description of the (somewhat extensive) GnuPG integration can
-be found by running the command `perldoc L<RT::Crypt::GnuPG>` (or
-`perldoc lib/RT/Crypt/GnuPG.pm` from your RT install directory).
-
-=over 4
-
-=item C<%GnuPG>
-
-Set C<OutgoingMessagesFormat> to 'inline' to use inline encryption and
-signatures instead of 'RFC' (GPG/MIME: RFC3156 and RFC1847) format.
-
-If you want to allow people to encrypt attachments inside the DB then
-set C<AllowEncryptDataInDB> to 1.
-
-Set C<RejectOnMissingPrivateKey> to false if you don't want to reject
-emails encrypted for key RT doesn't have and can not decrypt.
-
-Set C<RejectOnBadData> to false if you don't want to reject letters
-with incorrect GnuPG data.
-
-=cut
-
-Set(%GnuPG,
- Enable => 1,
- OutgoingMessagesFormat => "RFC", # Inline
- AllowEncryptDataInDB => 0,
-
- RejectOnMissingPrivateKey => 1,
- RejectOnBadData => 1,
-);
-
-=item C<%GnuPGOptions>
-
-Options to pass to the GnuPG program.
-
-If you override this in your RT_SiteConfig, you should be sure to
-include a homedir setting.
-
-Note that options with '-' character MUST be quoted.
-
-=cut
-
-Set(%GnuPGOptions,
- homedir => q{/opt/rt3/var/data/gpg},
-
-# URL of a keyserver
-# keyserver => 'hkp://subkeys.pgp.net',
-
-# enables the automatic retrieving of keys when encrypting
-# 'auto-key-locate' => 'keyserver',
-
-# enables the automatic retrieving of keys when verifying signatures
-# 'keyserver-options' => 'auto-key-retrieve',
-);
-
-=back
-
-
-
-=head1 Lifecycles
-
-=head2 Lifecycle definitions
-
-Each lifecycle is a list of possible statuses split into three logic
-sets: B<initial>, B<active> and B<inactive>. Each status in a
-lifecycle must be unique. (Statuses may not be repeated across sets.)
-Each set may have any number of statuses.
-
-For example:
-
- default => {
- initial => ['new'],
- active => ['open', 'stalled'],
- inactive => ['resolved', 'rejected', 'deleted'],
- ...
- },
-
-Status names can be from 1 to 64 ASCII characters. Statuses are
-localized using RT's standard internationalization and localization
-system.
-
-=over 4
-
-=item initial
-
-You can define multiple B<initial> statuses for tickets in a given
-lifecycle.
-
-RT will automatically set its B<Started> date when you change a
-ticket's status from an B<initial> state to an B<active> or
-B<inactive> status.
-
-=item active
-
-B<Active> tickets are "currently in play" - they're things that are
-being worked on and not yet complete.
-
-=item inactive
-
-B<Inactive> tickets are typically in their "final resting state".
-
-While you're free to implement a workflow that ignores that
-description, typically once a ticket enters an inactive state, it will
-never again enter an active state.
-
-RT will automatically set the B<Resolved> date when a ticket's status
-is changed from an B<Initial> or B<Active> status to an B<Inactive>
-status.
-
-B<deleted> is still a special status and protected by the
-B<DeleteTicket> right, unless you re-defined rights (read below). If
-you don't want to allow ticket deletion at any time simply don't
-include it in your lifecycle.
-
-=back
-
-Statuses in each set are ordered and listed in the UI in the defined
-order.
-
-Changes between statuses are constrained by transition rules, as
-described below.
-
-=head2 Default values
-
-In some cases a default value is used to display in UI or in API when
-value is not provided. You can configure defaults using the following
-syntax:
-
- default => {
- ...
- defaults => {
- on_create => 'new',
- on_resolve => 'resolved',
- ...
- },
- },
-
-The following defaults are used.
-
-=over 4
-
-=item on_create
-
-If you (or your code) doesn't specify a status when creating a ticket,
-RT will use the this status. See also L</Statuses available during
-ticket creation>.
-
-=item on_merge
-
-When tickets are merged, the status of the ticket that was merged
-away is forced to this value. It should be one of inactive statuses;
-'resolved' or its equivalent is most probably the best candidate.
-
-=item approved
-
-When an approval is accepted, the status of depending tickets will
-be changed to this value.
-
-=item denied
-
-When an approval is denied, the status of depending tickets will
-be changed to this value.
-
-=item reminder_on_open
-
-When a reminder is opened, the status will be changed to this value.
-
-=item reminder_on_resolve
-
-When a reminder is resolved, the status will be changed to this value.
-
-=back
-
-=head2 Transitions between statuses and UI actions
-
-A B<Transition> is a change of status from A to B. You should define
-all possible transitions in each lifecycle using the following format:
-
- default => {
- ...
- transitions => {
- '' => [qw(new open resolved)],
- new => [qw(open resolved rejected deleted)],
- open => [qw(stalled resolved rejected deleted)],
- stalled => [qw(open)],
- resolved => [qw(open)],
- rejected => [qw(open)],
- deleted => [qw(open)],
- },
- ...
- },
-
-=head3 Statuses available during ticket creation
-
-By default users can create tickets with a status of new,
-open, or resolved, but cannot create tickets with a status of
-rejected, stalled, or deleted. If you want to change the statuses
-available during creation, update the transition from '' (empty
-string), like in the example above.
-
-=head3 Protecting status changes with rights
-
-A transition or group of transitions can be protected by a specific
-right. Additionally, you can name new right names, which will be added
-to the system to control that transition. For example, if you wished to
-create a lesser right than ModifyTicket for rejecting tickets, you could
-write:
-
- default => {
- ...
- rights => {
- '* -> deleted' => 'DeleteTicket',
- '* -> rejected' => 'RejectTicket',
- '* -> *' => 'ModifyTicket',
- },
- ...
- },
-
-This would create a new C<RejectTicket> right in the system which you
-could assign to whatever groups you choose.
-
-On the left hand side you can have the following variants:
-
- '<from> -> <to>'
- '* -> <to>'
- '<from> -> *'
- '* -> *'
-
-Valid transitions are listed in order of priority. If a user attempts
-to change a ticket's status from B<new> to B<open> then the lifecycle
-is checked for presence of an exact match, then for 'any to B<open>',
-'B<new> to any' and finally 'any to any'.
-
-If you don't define any rights, or there is no match for a transition,
-RT will use the B<DeleteTicket> or B<ModifyTicket> as appropriate.
-
-=head3 Labeling and defining actions
-
-For each transition you can define an action that will be shown in the
-UI; each action annotated with a label and an update type.
-
-Each action may provide a default update type, which can be
-B<Comment>, B<Respond>, or absent. For example, you may want your
-staff to write a reply to the end user when they change status from
-B<new> to B<open>, and thus set the update to B<Respond>. Neither
-B<Comment> nor B<Respond> are mandatory, and user may leave the
-message empty, regardless of the update type.
-
-This configuration can be used to accomplish what
-$ResolveDefaultUpdateType was used for in RT 3.8.
-
-Use the following format to define labels and actions of transitions:
-
- default => {
- ...
- actions => [
- 'new -> open' => { label => 'Open it', update => 'Respond' },
- 'new -> resolved' => { label => 'Resolve', update => 'Comment' },
- 'new -> rejected' => { label => 'Reject', update => 'Respond' },
- 'new -> deleted' => { label => 'Delete' },
-
- 'open -> stalled' => { label => 'Stall', update => 'Comment' },
- 'open -> resolved' => { label => 'Resolve', update => 'Comment' },
- 'open -> rejected' => { label => 'Reject', update => 'Respond' },
-
- 'stalled -> open' => { label => 'Open it' },
- 'resolved -> open' => { label => 'Re-open', update => 'Comment' },
- 'rejected -> open' => { label => 'Re-open', update => 'Comment' },
- 'deleted -> open' => { label => 'Undelete' },
- ],
- ...
- },
-
-In addition, you may define multiple actions for the same transition.
-Alternately, you may use '* -> x' to match more than one transition.
-For example:
-
- default => {
- ...
- actions => [
- ...
- 'new -> rejected' => { label => 'Reject', update => 'Respond' },
- 'new -> rejected' => { label => 'Quick Reject' },
- ...
- '* -> deleted' => { label => 'Delete' },
- ...
- ],
- ...
- },
-
-=head2 Moving tickets between queues with different lifecycles
-
-Unless there is an explicit mapping between statuses in two different
-lifecycles, you can not move tickets between queues with these
-lifecycles. This is true even if the different lifecycles use the exact
-same set of statuses. Such a mapping is defined as follows:
-
- __maps__ => {
- 'from lifecycle -> to lifecycle' => {
- 'status in left lifecycle' => 'status in right lifecycle',
- ...
- },
- ...
- },
-
-=cut
-
-Set(%Lifecycles,
- default => {
- initial => [ 'new' ],
- active => [ 'open', 'stalled' ],
- inactive => [ 'resolved', 'rejected', 'deleted' ],
-
- defaults => {
- on_create => 'new',
- on_merge => 'resolved',
- approved => 'open',
- denied => 'rejected',
- reminder_on_open => 'open',
- reminder_on_resolve => 'resolved',
- },
-
- transitions => {
- '' => [qw(new open resolved)],
-
- # from => [ to list ],
- new => [qw(open stalled resolved rejected deleted)],
- open => [qw(new stalled resolved rejected deleted)],
- stalled => [qw(new open rejected resolved deleted)],
- resolved => [qw(new open stalled rejected deleted)],
- rejected => [qw(new open stalled resolved deleted)],
- deleted => [qw(new open stalled rejected resolved)],
- },
- rights => {
- '* -> deleted' => 'DeleteTicket',
- '* -> *' => 'ModifyTicket',
- },
- actions => [
- 'new -> open' => {
- label => 'Open It', # loc
- update => 'Respond',
- },
- 'new -> resolved' => {
- label => 'Resolve', # loc
- update => 'Comment',
- },
- 'new -> rejected' => {
- label => 'Reject', # loc
- update => 'Respond',
- },
- 'new -> deleted' => {
- label => 'Delete', # loc
- },
-
- 'open -> stalled' => {
- label => 'Stall', # loc
- update => 'Comment',
- },
- 'open -> resolved' => {
- label => 'Resolve', # loc
- update => 'Comment',
- },
- 'open -> rejected' => {
- label => 'Reject', # loc
- update => 'Respond',
- },
-
- 'stalled -> open' => {
- label => 'Open It', # loc
- },
- 'resolved -> open' => {
- label => 'Re-open', # loc
- update => 'Comment',
- },
- 'rejected -> open' => {
- label => 'Re-open', # loc
- update => 'Comment',
- },
- 'deleted -> open' => {
- label => 'Undelete', # loc
- },
- ],
- },
-# don't change lifecyle of the approvals, they are not capable to deal with
-# custom statuses
- approvals => {
- initial => [ 'new' ],
- active => [ 'open', 'stalled' ],
- inactive => [ 'resolved', 'rejected', 'deleted' ],
-
- defaults => {
- on_create => 'new',
- on_merge => 'resolved',
- reminder_on_open => 'open',
- reminder_on_resolve => 'resolved',
- },
-
- transitions => {
- '' => [qw(new open resolved)],
-
- # from => [ to list ],
- new => [qw(open stalled resolved rejected deleted)],
- open => [qw(new stalled resolved rejected deleted)],
- stalled => [qw(new open rejected resolved deleted)],
- resolved => [qw(new open stalled rejected deleted)],
- rejected => [qw(new open stalled resolved deleted)],
- deleted => [qw(new open stalled rejected resolved)],
- },
- rights => {
- '* -> deleted' => 'DeleteTicket',
- '* -> rejected' => 'ModifyTicket',
- '* -> *' => 'ModifyTicket',
- },
- actions => [
- 'new -> open' => {
- label => 'Open It', # loc
- update => 'Respond',
- },
- 'new -> resolved' => {
- label => 'Resolve', # loc
- update => 'Comment',
- },
- 'new -> rejected' => {
- label => 'Reject', # loc
- update => 'Respond',
- },
- 'new -> deleted' => {
- label => 'Delete', # loc
- },
-
- 'open -> stalled' => {
- label => 'Stall', # loc
- update => 'Comment',
- },
- 'open -> resolved' => {
- label => 'Resolve', # loc
- update => 'Comment',
- },
- 'open -> rejected' => {
- label => 'Reject', # loc
- update => 'Respond',
- },
-
- 'stalled -> open' => {
- label => 'Open It', # loc
- },
- 'resolved -> open' => {
- label => 'Re-open', # loc
- update => 'Comment',
- },
- 'rejected -> open' => {
- label => 'Re-open', # loc
- update => 'Comment',
- },
- 'deleted -> open' => {
- label => 'Undelete', # loc
- },
- ],
- },
-);
-
-
-
-
-
-=head1 Administrative interface
-
-=over 4
-
-=item C<$ShowRTPortal>
-
-RT can show administrators a feed of recent RT releases and other
-related announcements and information from Best Practical on the top
-level Configuration page. This feature helps you stay up to date on
-RT security announcements and version updates.
-
-RT provides this feature using an "iframe" on C</Admin/index.html>
-which asks the administrator's browser to show an inline page from
-Best Practical's website.
-
-If you'd rather not make this feature available to your
-administrators, set C<$ShowRTPortal> to a false value.
-
-=cut
-
-Set($ShowRTPortal, 1);
-
-=item C<%AdminSearchResultFormat>
-
-In the admin interface, format strings similar to tickets result
-formats are used. Use C<%AdminSearchResultFormat> to define the format
-strings used in the admin interface on a per-RT-class basis.
-
-=cut
-
-Set(%AdminSearchResultFormat,
- Queues =>
- q{'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Queues/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,__Description__,__Address__,__Priority__,__DefaultDueIn__,__Disabled__,__Lifecycle__},
-
- Groups =>
- q{'<a href="__WebPath__/Admin/Groups/Modify.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Groups/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,'__Description__'},
-
- Users =>
- q{'<a href="__WebPath__/Admin/Users/Modify.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Users/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,__RealName__, __EmailAddress__},
-
- CustomFields =>
- q{'<a href="__WebPath__/Admin/CustomFields/Modify.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/CustomFields/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,__AppliedTo__, __FriendlyType__, __FriendlyPattern__},
-
- Scrips =>
- q{'<a href="__WebPath__/Admin/Queues/Scrip.html?id=__id__&Queue=__QueueId__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Queues/Scrip.html?id=__id__&Queue=__QueueId__">__Description__</a>/TITLE:Description'}
- .q{,__Stage__, __Condition__, __Action__, __Template__},
-
- GlobalScrips =>
- q{'<a href="__WebPath__/Admin/Global/Scrip.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Global/Scrip.html?id=__id__">__Description__</a>/TITLE:Description'}
- .q{,__Stage__, __Condition__, __Action__, __Template__},
-
- Templates =>
- q{'<a href="__WebPath__/__WebRequestPathDir__/Template.html?Queue=__QueueId__&Template=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/__WebRequestPathDir__/Template.html?Queue=__QueueId__&Template=__id__">__Name__</a>/TITLE:Name'}
- .q{,'__Description__'},
- Classes =>
- q{ '<a href="__WebPath__/Admin/Articles/Classes/Modify.html?id=__id__">__id__</a>/TITLE:#'}
- .q{,'<a href="__WebPath__/Admin/Articles/Classes/Modify.html?id=__id__">__Name__</a>/TITLE:Name'}
- .q{,__Description__},
-);
-
-=back
-
-
-
-
-=head1 Development options
-
-=over 4
-
-=item C<$DevelMode>
-
-RT comes with a "Development mode" setting. This setting, as a
-convenience for developers, turns on several of development options
-that you most likely don't want in production:
-
-=over 4
-
-=item *
-
-Disables CSS and JS minification and concatenation. Both CSS and JS
-will be instead be served as a number of individual smaller files,
-unchanged from how they are stored on disk.
-
-=item *
-
-Uses L<Module::Refresh> to reload changed Perl modules on each
-request.
-
-=item *
-
-Turns off Mason's C<static_source> directive; this causes Mason to
-reload template files which have been modified on disk.
-
-=item *
-
-Turns on Mason's HTML C<error_format>; this renders compilation errors
-to the browser, along with a full stack trace. It is possible for
-stack traces to reveal sensitive information such as passwords or
-ticket content.
-
-=item *
-
-Turns off caching of callbacks; this enables additional callbacks to
-be added while the server is running.
-
-=back
-
-=cut
-
-Set($DevelMode, "0");
-
-
-=item C<$RecordBaseClass>
-
-What abstract base class should RT use for its records. You should
-probably never change this.
-
-Valid values are C<DBIx::SearchBuilder::Record> or
-C<DBIx::SearchBuilder::Record::Cachable>
-
-=cut
-
-Set($RecordBaseClass, "DBIx::SearchBuilder::Record::Cachable");
-
-
-=item C<@MasonParameters>
-
-C<@MasonParameters> is the list of parameters for the constructor of
-HTML::Mason's Apache or CGI Handler. This is normally only useful for
-debugging, e.g. profiling individual components with:
-
- use MasonX::Profiler; # available on CPAN
- Set(@MasonParameters, (preamble => 'my $p = MasonX::Profiler->new($m, $r);'));
-
-=cut
-
-Set(@MasonParameters, ());
-
-=item C<$StatementLog>
-
-RT has rudimentary SQL statement logging support; simply set
-C<$StatementLog> to be the level that you wish SQL statements to be
-logged at.
-
-Enabling this option will also expose the SQL Queries page in the
-Configuration -> Tools menu for SuperUsers.
-
-=cut
-
-Set($StatementLog, undef);
-
-=back
-
-
-
-
-=head1 Deprecated options
-
-=over 4
-
-=item C<$LinkTransactionsRun1Scrip>
-
-RT-3.4 backward compatibility setting. Add/Delete Link used to record
-one transaction and run one scrip. Set this value to 1 if you want
-only one of the link transactions to have scrips run.
-
-=cut
-
-Set($LinkTransactionsRun1Scrip, 0);
-
-=item C<$ResolveDefaultUpdateType>
-
-This option has been deprecated. You can configure this site-wide
-with L</Lifecycles> (see L</Labeling and defining actions>).
-
-=back
-
-=cut
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-use strict;
-use warnings;
-
-package RT;
-
-
-use File::Spec ();
-use Cwd ();
-
-use vars qw($Config $System $SystemUser $Nobody $Handle $Logger $_Privileged $_Unprivileged $_INSTALL_MODE);
-
-use vars qw($BasePath
- $EtcPath
- $BinPath
- $SbinPath
- $VarPath
- $LexiconPath
- $PluginPath
- $LocalPath
- $LocalEtcPath
- $LocalLibPath
- $LocalLexiconPath
- $LocalPluginPath
- $MasonComponentRoot
- $MasonLocalComponentRoot
- $MasonDataDir
- $MasonSessionDir);
-
-
-RT->LoadGeneratedData();
-
-=head1 NAME
-
-RT - Request Tracker
-
-=head1 SYNOPSIS
-
-A fully featured request tracker package.
-
-This documentation describes the point-of-entry for RT's Perl API. To learn
-more about what RT is and what it can do for you, visit
-L<https://bestpractical.com/rt>.
-
-=head1 DESCRIPTION
-
-=head2 INITIALIZATION
-
-If you're using RT's Perl libraries, you need to initialize RT before using any
-of the modules.
-
-You have the option of handling the timing of config loading and the actual
-init sequence yourself with:
-
- use RT;
- BEGIN {
- RT->LoadConfig;
- RT->Init;
- }
-
-or you can let RT do it all:
-
- use RT -init;
-
-This second method is particular useful when writing one-liners to interact with RT:
-
- perl -MRT=-init -e '...'
-
-The first method is necessary if you need to delay or conditionalize
-initialization or if you want to fiddle with C<< RT->Config >> between loading
-the config files and initializing the RT environment.
-
-=cut
-
-{
- my $DID_IMPORT_INIT;
- sub import {
- my $class = shift;
- my $action = shift || '';
-
- if ($action eq "-init" and not $DID_IMPORT_INIT) {
- $class->LoadConfig;
- $class->Init;
- $DID_IMPORT_INIT = 1;
- }
- }
-}
-
-=head2 LoadConfig
-
-Load RT's config file. First, the site configuration file
-(F<RT_SiteConfig.pm>) is loaded, in order to establish overall site
-settings like hostname and name of RT instance. Then, the core
-configuration file (F<RT_Config.pm>) is loaded to set fallback values
-for all settings; it bases some values on settings from the site
-configuration file.
-
-In order for the core configuration to not override the site's
-settings, the function C<Set> is used; it only sets values if they
-have not been set already.
-
-=cut
-
-sub LoadConfig {
- require RT::Config;
- $Config = RT::Config->new;
- $Config->LoadConfigs;
- require RT::I18N;
-
- # RT::Essentials mistakenly recommends that WebPath be set to '/'.
- # If the user does that, do what they mean.
- $RT::WebPath = '' if ($RT::WebPath eq '/');
-
- # fix relative LogDir and GnuPG homedir
- unless ( File::Spec->file_name_is_absolute( $Config->Get('LogDir') ) ) {
- $Config->Set( LogDir =>
- File::Spec->catfile( $BasePath, $Config->Get('LogDir') ) );
- }
-
- my $gpgopts = $Config->Get('GnuPGOptions');
- unless ( File::Spec->file_name_is_absolute( $gpgopts->{homedir} ) ) {
- $gpgopts->{homedir} = File::Spec->catfile( $BasePath, $gpgopts->{homedir} );
- }
-
- return $Config;
-}
-
-=head2 Init
-
-L<Connects to the database|/ConnectToDatabase>, L<initilizes system
-objects|/InitSystemObjects>, L<preloads classes|/InitClasses>, L<sets
-up logging|/InitLogging>, and L<loads plugins|/InitPlugins>.
-
-=cut
-
-sub Init {
- shift if @_%2; # code is inconsistent about calling as method
- my %args = (@_);
-
- CheckPerlRequirements();
-
- InitPluginPaths();
-
- #Get a database connection
- ConnectToDatabase();
- InitSystemObjects();
- InitClasses(%args);
- InitLogging(%args);
- InitPlugins();
- RT::I18N->Init;
- RT->Config->PostLoadCheck;
-
-}
-
-=head2 ConnectToDatabase
-
-Get a database connection. See also L</Handle>.
-
-=cut
-
-sub ConnectToDatabase {
- require RT::Handle;
- $Handle = RT::Handle->new unless $Handle;
- $Handle->Connect;
- return $Handle;
-}
-
-=head2 InitLogging
-
-Create the Logger object and set up signal handlers.
-
-=cut
-
-sub InitLogging {
-
- my %arg = @_;
-
- # We have to set the record separator ($, man perlvar)
- # or Log::Dispatch starts getting
- # really pissy, as some other module we use unsets it.
- $, = '';
- use Log::Dispatch 1.6;
-
- my %level_to_num = (
- map( { $_ => } 0..7 ),
- debug => 0,
- info => 1,
- notice => 2,
- warning => 3,
- error => 4, 'err' => 4,
- critical => 5, crit => 5,
- alert => 6,
- emergency => 7, emerg => 7,
- );
-
- unless ( $RT::Logger ) {
-
- $RT::Logger = Log::Dispatch->new;
-
- my $stack_from_level;
- if ( $stack_from_level = RT->Config->Get('LogStackTraces') ) {
- # if option has old style '\d'(true) value
- $stack_from_level = 0 if $stack_from_level =~ /^\d+$/;
- $stack_from_level = $level_to_num{ $stack_from_level } || 0;
- } else {
- $stack_from_level = 99; # don't log
- }
-
- my $simple_cb = sub {
- # if this code throw any warning we can get segfault
- no warnings;
- my %p = @_;
-
- # skip Log::* stack frames
- my $frame = 0;
- $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
- my ($package, $filename, $line) = caller($frame);
-
- $p{'message'} =~ s/(?:\r*\n)+$//;
- return "[$$] [". gmtime(time) ."] [". $p{'level'} ."]: "
- . $p{'message'} ." ($filename:$line)\n";
- };
-
- my $syslog_cb = sub {
- # if this code throw any warning we can get segfault
- no warnings;
- my %p = @_;
-
- my $frame = 0; # stack frame index
- # skip Log::* stack frames
- $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
- my ($package, $filename, $line) = caller($frame);
-
- # syswrite() cannot take utf8; turn it off here.
- Encode::_utf8_off($p{message});
-
- $p{message} =~ s/(?:\r*\n)+$//;
- if ($p{level} eq 'debug') {
- return "[$$] $p{message} ($filename:$line)\n";
- } else {
- return "[$$] $p{message}\n";
- }
- };
-
- my $stack_cb = sub {
- no warnings;
- my %p = @_;
- return $p{'message'} unless $level_to_num{ $p{'level'} } >= $stack_from_level;
-
- require Devel::StackTrace;
- my $trace = Devel::StackTrace->new( ignore_class => [ 'Log::Dispatch', 'Log::Dispatch::Base' ] );
- return $p{'message'} . $trace->as_string;
-
- # skip calling of the Log::* subroutins
- my $frame = 0;
- $frame++ while caller($frame) && caller($frame) =~ /^Log::/;
- $frame++ while caller($frame) && (caller($frame))[3] =~ /^Log::/;
-
- $p{'message'} .= "\nStack trace:\n";
- while( my ($package, $filename, $line, $sub) = caller($frame++) ) {
- $p{'message'} .= "\t$sub(...) called at $filename:$line\n";
- }
- return $p{'message'};
- };
-
- if ( $Config->Get('LogToFile') ) {
- my ($filename, $logdir) = (
- $Config->Get('LogToFileNamed') || 'rt.log',
- $Config->Get('LogDir') || File::Spec->catdir( $VarPath, 'log' ),
- );
- if ( $filename =~ m![/\\]! ) { # looks like an absolute path.
- ($logdir) = $filename =~ m{^(.*[/\\])};
- }
- else {
- $filename = File::Spec->catfile( $logdir, $filename );
- }
-
- unless ( -d $logdir && ( ( -f $filename && -w $filename ) || -w $logdir ) ) {
- # localizing here would be hard when we don't have a current user yet
- die "Log file '$filename' couldn't be written or created.\n RT can't run.";
- }
-
- require Log::Dispatch::File;
- $RT::Logger->add( Log::Dispatch::File->new
- ( name=>'file',
- min_level=> $Config->Get('LogToFile'),
- filename=> $filename,
- mode=>'append',
- callbacks => [ $simple_cb, $stack_cb ],
- ));
- }
- if ( $Config->Get('LogToScreen') ) {
- require Log::Dispatch::Screen;
- $RT::Logger->add( Log::Dispatch::Screen->new
- ( name => 'screen',
- min_level => $Config->Get('LogToScreen'),
- callbacks => [ $simple_cb, $stack_cb ],
- stderr => 1,
- ));
- }
- if ( $Config->Get('LogToSyslog') ) {
- require Log::Dispatch::Syslog;
- $RT::Logger->add(Log::Dispatch::Syslog->new
- ( name => 'syslog',
- ident => 'RT',
- min_level => $Config->Get('LogToSyslog'),
- callbacks => [ $syslog_cb, $stack_cb ],
- stderr => 1,
- $Config->Get('LogToSyslogConf'),
- ));
- }
- }
- InitSignalHandlers(%arg);
-}
-
-{ # Work around bug in Log::Dispatch < 2.30, wherein the short forms
- # of ->warn, ->err, and ->crit do not usefully propagate out, unlike
- # ->warning, ->error, and ->critical
- package Log::Dispatch;
- no warnings 'redefine';
- sub warn { shift->warning(@_) }
- sub err { shift->error(@_) }
- sub crit { shift->critical(@_) }
-}
-
-sub InitSignalHandlers {
-
- my %arg = @_;
- return if $arg{'NoSignalHandlers'};
-
-# Signal handlers
-## This is the default handling of warnings and die'ings in the code
-## (including other used modules - maybe except for errors catched by
-## Mason). It will log all problems through the standard logging
-## mechanism (see above).
-
- $SIG{__WARN__} = sub {
- # The 'wide character' warnings has to be silenced for now, at least
- # until HTML::Mason offers a sane way to process both raw output and
- # unicode strings.
- # use 'goto &foo' syntax to hide ANON sub from stack
- if( index($_[0], 'Wide character in ') != 0 ) {
- unshift @_, $RT::Logger, qw(level warning message);
- goto &Log::Dispatch::log;
- }
- # Return value is used only by RT::Test to filter warnings from
- # reaching the Test::NoWarnings catcher. If Log::Dispatch::log() ever
- # starts returning 'IGNORE', we'll need to switch to something more
- # clever. I don't expect that to happen.
- return 'IGNORE';
- };
-
-#When we call die, trap it and log->crit with the value of the die.
-
- $SIG{__DIE__} = sub {
- # if we are not in eval and perl is not parsing code
- # then rollback transactions and log RT error
- unless ($^S || !defined $^S ) {
- $RT::Handle->Rollback(1) if $RT::Handle;
- $RT::Logger->crit("$_[0]") if $RT::Logger;
- }
- die $_[0];
- };
-}
-
-
-sub CheckPerlRequirements {
- if ($^V < 5.008003) {
- die sprintf "RT requires Perl v5.8.3 or newer. Your current Perl is v%vd\n", $^V;
- }
-
- # use $error here so the following "die" can still affect the global $@
- my $error;
- {
- local $@;
- eval {
- my $x = '';
- my $y = \$x;
- require Scalar::Util;
- Scalar::Util::weaken($y);
- };
- $error = $@;
- }
-
- if ($error) {
- die <<"EOF";
-
-RT requires the Scalar::Util module be built with support for the 'weaken'
-function.
-
-It is sometimes the case that operating system upgrades will replace
-a working Scalar::Util with a non-working one. If your system was working
-correctly up until now, this is likely the cause of the problem.
-
-Please reinstall Scalar::Util, being careful to let it build with your C
-compiler. Usually this is as simple as running the following command as
-root.
-
- perl -MCPAN -e'install Scalar::Util'
-
-EOF
-
- }
-}
-
-=head2 InitClasses
-
-Load all modules that define base classes.
-
-=cut
-
-sub InitClasses {
- shift if @_%2; # so we can call it as a function or method
- my %args = (@_);
- require RT::Tickets;
- require RT::Transactions;
- require RT::Attachments;
- require RT::Users;
- require RT::Principals;
- require RT::CurrentUser;
- require RT::Templates;
- require RT::Queues;
- require RT::ScripActions;
- require RT::ScripConditions;
- require RT::Scrips;
- require RT::Groups;
- require RT::GroupMembers;
- require RT::CustomFields;
- require RT::CustomFieldValues;
- require RT::ObjectCustomFields;
- require RT::ObjectCustomFieldValues;
- require RT::Attributes;
- require RT::Dashboard;
- require RT::Approval;
- require RT::Lifecycle;
- require RT::Link;
- require RT::Links;
- require RT::Article;
- require RT::Articles;
- require RT::Class;
- require RT::Classes;
- require RT::ObjectClass;
- require RT::ObjectClasses;
- require RT::ObjectTopic;
- require RT::ObjectTopics;
- require RT::Topic;
- require RT::Topics;
-
- # on a cold server (just after restart) people could have an object
- # in the session, as we deserialize it so we never call constructor
- # of the class, so the list of accessible fields is empty and we die
- # with "Method xxx is not implemented in RT::SomeClass"
-
- # without this, we also can never call _ClassAccessible, because we
- # won't have filled RT::Record::_TABLE_ATTR
- $_->_BuildTableAttributes foreach qw(
- RT::Ticket
- RT::Transaction
- RT::Attachment
- RT::User
- RT::Principal
- RT::Template
- RT::Queue
- RT::ScripAction
- RT::ScripCondition
- RT::Scrip
- RT::Group
- RT::GroupMember
- RT::CustomField
- RT::CustomFieldValue
- RT::ObjectCustomField
- RT::ObjectCustomFieldValue
- RT::Attribute
- RT::ACE
- RT::Link
- RT::Article
- RT::Class
- RT::ObjectClass
- RT::ObjectTopic
- RT::Topic
- );
-
- if ( $args{'Heavy'} ) {
- # load scrips' modules
- my $scrips = RT::Scrips->new(RT->SystemUser);
- $scrips->Limit( FIELD => 'Stage', OPERATOR => '!=', VALUE => 'Disabled' );
- while ( my $scrip = $scrips->Next ) {
- local $@;
- eval { $scrip->LoadModules } or
- $RT::Logger->error("Invalid Scrip ".$scrip->Id.". Unable to load the Action or Condition. ".
- "You should delete or repair this Scrip in the admin UI.\n$@\n");
- }
-
- foreach my $class ( grep $_, RT->Config->Get('CustomFieldValuesSources') ) {
- local $@;
- eval "require $class; 1" or $RT::Logger->error(
- "Class '$class' is listed in CustomFieldValuesSources option"
- ." in the config, but we failed to load it:\n$@\n"
- );
- }
-
- }
-}
-
-=head2 InitSystemObjects
-
-Initializes system objects: C<$RT::System>, C<< RT->SystemUser >>
-and C<< RT->Nobody >>.
-
-=cut
-
-sub InitSystemObjects {
-
- #RT's system user is a genuine database user. its id lives here
- require RT::CurrentUser;
- $SystemUser = RT::CurrentUser->new;
- $SystemUser->LoadByName('RT_System');
-
- #RT's "nobody user" is a genuine database user. its ID lives here.
- $Nobody = RT::CurrentUser->new;
- $Nobody->LoadByName('Nobody');
-
- require RT::System;
- $System = RT::System->new( $SystemUser );
-}
-
-=head1 CLASS METHODS
-
-=head2 Config
-
-Returns the current L<config object|RT::Config>, but note that
-you must L<load config|/LoadConfig> first otherwise this method
-returns undef.
-
-Method can be called as class method.
-
-=cut
-
-sub Config { return $Config || shift->LoadConfig(); }
-
-=head2 DatabaseHandle
-
-Returns the current L<database handle object|RT::Handle>.
-
-See also L</ConnectToDatabase>.
-
-=cut
-
-sub DatabaseHandle { return $Handle }
-
-=head2 Logger
-
-Returns the logger. See also L</InitLogging>.
-
-=cut
-
-sub Logger { return $Logger }
-
-=head2 System
-
-Returns the current L<system object|RT::System>. See also
-L</InitSystemObjects>.
-
-=cut
-
-sub System { return $System }
-
-=head2 SystemUser
-
-Returns the system user's object, it's object of
-L<RT::CurrentUser> class that represents the system. See also
-L</InitSystemObjects>.
-
-=cut
-
-sub SystemUser { return $SystemUser }
-
-=head2 Nobody
-
-Returns object of Nobody. It's object of L<RT::CurrentUser> class
-that represents a user who can own ticket and nothing else. See
-also L</InitSystemObjects>.
-
-=cut
-
-sub Nobody { return $Nobody }
-
-sub PrivilegedUsers {
- if (!$_Privileged) {
- $_Privileged = RT::Group->new(RT->SystemUser);
- $_Privileged->LoadSystemInternalGroup('Privileged');
- }
- return $_Privileged;
-}
-
-sub UnprivilegedUsers {
- if (!$_Unprivileged) {
- $_Unprivileged = RT::Group->new(RT->SystemUser);
- $_Unprivileged->LoadSystemInternalGroup('Unprivileged');
- }
- return $_Unprivileged;
-}
-
-
-=head2 Plugins
-
-Returns a listref of all Plugins currently configured for this RT instance.
-You can define plugins by adding them to the @Plugins list in your RT_SiteConfig
-
-=cut
-
-our @PLUGINS = ();
-sub Plugins {
- my $self = shift;
- unless (@PLUGINS) {
- $self->InitPluginPaths;
- @PLUGINS = $self->InitPlugins;
- }
- return \@PLUGINS;
-}
-
-=head2 PluginDirs
-
-Takes an optional subdir (e.g. po, lib, etc.) and returns a list of
-directories from plugins where that subdirectory exists.
-
-This code does not check plugin names, plugin validitity, or load
-plugins (see L</InitPlugins>) in any way, and requires that RT's
-configuration have been already loaded.
-
-=cut
-
-sub PluginDirs {
- my $self = shift;
- my $subdir = shift;
-
- require RT::Plugin;
-
- my @res;
- foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
- my $path = RT::Plugin->new( name => $plugin )->Path( $subdir );
- next unless -d $path;
- push @res, $path;
- }
- return @res;
-}
-
-=head2 InitPluginPaths
-
-Push plugins' lib paths into @INC right after F<local/lib>.
-In case F<local/lib> isn't in @INC, append them to @INC
-
-=cut
-
-sub InitPluginPaths {
- my $self = shift || __PACKAGE__;
-
- my @lib_dirs = $self->PluginDirs('lib');
-
- my @tmp_inc;
- my $added;
- for (@INC) {
- my $realpath = Cwd::realpath($_);
- next unless defined $realpath;
- if ( $realpath eq $RT::LocalLibPath) {
- push @tmp_inc, $_, @lib_dirs;
- $added = 1;
- } else {
- push @tmp_inc, $_;
- }
- }
-
- # append @lib_dirs in case $RT::LocalLibPath isn't in @INC
- push @tmp_inc, @lib_dirs unless $added;
-
- my %seen;
- @INC = grep !$seen{$_}++, @tmp_inc;
-}
-
-=head2 InitPlugins
-
-Initialize all Plugins found in the RT configuration file, setting up
-their lib and L<HTML::Mason> component roots.
-
-=cut
-
-sub InitPlugins {
- my $self = shift;
- my @plugins;
- require RT::Plugin;
- foreach my $plugin (grep $_, RT->Config->Get('Plugins')) {
- $plugin->require;
- die $UNIVERSAL::require::ERROR if ($UNIVERSAL::require::ERROR);
- push @plugins, RT::Plugin->new(name =>$plugin);
- }
- return @plugins;
-}
-
-
-sub InstallMode {
- my $self = shift;
- if (@_) {
- my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
- if ($_[0] and $integrity) {
- # Trying to turn install mode on but we have a good DB!
- require Carp;
- $RT::Logger->error(
- Carp::longmess("Something tried to turn on InstallMode but we have DB integrity!")
- );
- }
- else {
- $_INSTALL_MODE = shift;
- if($_INSTALL_MODE) {
- require RT::CurrentUser;
- $SystemUser = RT::CurrentUser->new();
- }
- }
- }
- return $_INSTALL_MODE;
-}
-
-sub LoadGeneratedData {
- my $class = shift;
- my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
-
- require "$pm_path/RT/Generated.pm" || die "Couldn't load RT::Generated: $@";
- $class->CanonicalizeGeneratedPaths();
-}
-
-sub CanonicalizeGeneratedPaths {
- my $class = shift;
- unless ( File::Spec->file_name_is_absolute($EtcPath) ) {
-
- # if BasePath exists and is absolute, we won't infer it from $INC{'RT.pm'}.
- # otherwise RT.pm will make the source dir(where we configure RT) be the
- # BasePath instead of the one specified by --prefix
- unless ( -d $BasePath
- && File::Spec->file_name_is_absolute($BasePath) )
- {
- my $pm_path = ( File::Spec->splitpath( $INC{'RT.pm'} ) )[1];
-
- # need rel2abs here is to make sure path is absolute, since $INC{'RT.pm'}
- # is not always absolute
- $BasePath = File::Spec->rel2abs(
- File::Spec->catdir( $pm_path, File::Spec->updir ) );
- }
-
- $BasePath = Cwd::realpath($BasePath);
-
- for my $path (
- qw/EtcPath BinPath SbinPath VarPath LocalPath LocalEtcPath
- LocalLibPath LexiconPath LocalLexiconPath PluginPath
- LocalPluginPath MasonComponentRoot MasonLocalComponentRoot
- MasonDataDir MasonSessionDir/
- )
- {
- no strict 'refs';
-
- # just change relative ones
- $$path = File::Spec->catfile( $BasePath, $$path )
- unless File::Spec->file_name_is_absolute($$path);
- }
- }
-
-}
-
-=head2 AddJavaScript
-
-helper method to add js files to C<JSFiles> config.
-to add extra js files, you can add the following line
-in the plugin's main file:
-
- RT->AddJavaScript( 'foo.js', 'bar.js' );
-
-=cut
-
-sub AddJavaScript {
- my $self = shift;
-
- my @old = RT->Config->Get('JSFiles');
- RT->Config->Set( 'JSFiles', @old, @_ );
- return RT->Config->Get('JSFiles');
-}
-
-=head2 AddStyleSheets
-
-helper method to add css files to C<CSSFiles> config
-
-to add extra css files, you can add the following line
-in the plugin's main file:
-
- RT->AddStyleSheets( 'foo.css', 'bar.css' );
-
-=cut
-
-sub AddStyleSheets {
- my $self = shift;
- my @old = RT->Config->Get('CSSFiles');
- RT->Config->Set( 'CSSFiles', @old, @_ );
- return RT->Config->Get('CSSFiles');
-}
-
-=head2 JavaScript
-
-helper method of RT->Config->Get('JSFiles')
-
-=cut
-
-sub JavaScript {
- return RT->Config->Get('JSFiles');
-}
-
-=head2 StyleSheets
-
-helper method of RT->Config->Get('CSSFiles')
-
-=cut
-
-sub StyleSheets {
- return RT->Config->Get('CSSFiles');
-}
-
-=head1 BUGS
-
-Please report them to rt-bugs@bestpractical.com, if you know what's
-broken and have at least some idea of what needs to be fixed.
-
-If you're not sure what's going on, report them rt-devel@lists.bestpractical.com.
-
-=head1 SEE ALSO
-
-L<RT::StyleGuide>
-L<DBIx::SearchBuilder>
-
-=cut
-
-require RT::Base;
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::Config;
-
-use strict;
-use warnings;
-
-
-use File::Spec ();
-
-=head1 NAME
-
- RT::Config - RT's config
-
-=head1 SYNOPSYS
-
- # get config object
- use RT::Config;
- my $config = RT::Config->new;
- $config->LoadConfigs;
-
- # get or set option
- my $rt_web_path = $config->Get('WebPath');
- $config->Set(EmailOutputEncoding => 'latin1');
-
- # get config object from RT package
- use RT;
- RT->LoadConfig;
- my $config = RT->Config;
-
-=head1 DESCRIPTION
-
-C<RT::Config> class provide access to RT's and RT extensions' config files.
-
-RT uses two files for site configuring:
-
-First file is F<RT_Config.pm> - core config file. This file is shipped
-with RT distribution and contains default values for all available options.
-B<You should never edit this file.>
-
-Second file is F<RT_SiteConfig.pm> - site config file. You can use it
-to customize your RT instance. In this file you can override any option
-listed in core config file.
-
-RT extensions could also provide thier config files. Extensions should
-use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for
-config files, where <NAME> is extension name.
-
-B<NOTE>: All options from RT's config and extensions' configs are saved
-in one place and thus extension could override RT's options, but it is not
-recommended.
-
-=cut
-
-=head2 %META
-
-Hash of Config options that may be user overridable
-or may require more logic than should live in RT_*Config.pm
-
-Keyed by config name, there are several properties that
-can be set for each config optin:
-
- Section - What header this option should be grouped
- under on the user Settings page
- Overridable - Can users change this option
- SortOrder - Within a Section, how should the options be sorted
- for display to the user
- Widget - Mason component path to widget that should be used
- to display this config option
- WidgetArguments - An argument hash passed to the WIdget
- Description - Friendly description to show the user
- Values - Arrayref of options (for select Widget)
- ValuesLabel - Hashref, key is the Value from the Values
- list, value is a user friendly description
- of the value
- Callback - subref that receives no arguments. It returns
- a hashref of items that are added to the rest
- of the WidgetArguments
- PostLoadCheck - subref passed the RT::Config object and the current
- setting of the config option. Can make further checks
- (such as seeing if a library is installed) and then change
- the setting of this or other options in the Config using
- the RT::Config option.
- Obfuscate - subref passed the RT::Config object, current setting of the config option
- and a user object, can return obfuscated value. it's called in
- RT->Config->GetObfuscated()
-
-=cut
-
-our %META = (
- # General user overridable options
- DefaultQueue => {
- Section => 'General',
- Overridable => 1,
- SortOrder => 1,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Default queue', #loc
- Callback => sub {
- my $ret = { Values => [], ValuesLabel => {}};
- my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'});
- $q->UnLimit;
- while (my $queue = $q->Next) {
- next unless $queue->CurrentUserHasRight("CreateTicket");
- push @{$ret->{Values}}, $queue->Id;
- $ret->{ValuesLabel}{$queue->Id} = $queue->Name;
- }
- return $ret;
- },
- }
- },
- RememberDefaultQueue => {
- Section => 'General',
- Overridable => 1,
- SortOrder => 2,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Remember default queue' # loc
- }
- },
- UsernameFormat => {
- Section => 'General',
- Overridable => 1,
- SortOrder => 3,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Username format', # loc
- Values => [qw(concise verbose)],
- ValuesLabel => {
- concise => 'Short usernames', # loc
- verbose => 'Name and email address', # loc
- },
- },
- },
- AutocompleteOwners => {
- Section => 'General',
- Overridable => 1,
- SortOrder => 3.1,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Use autocomplete to find owners?', # loc
- Hints => 'Replaces the owner dropdowns with textboxes' #loc
- }
- },
- WebDefaultStylesheet => {
- Section => 'General', #loc
- Overridable => 1,
- SortOrder => 4,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Theme', #loc
- # XXX: we need support for 'get values callback'
- Values => [qw(web2 freeside2.1 freeside3 aileron ballard)],
- },
- PostLoadCheck => sub {
- my $self = shift;
- my $value = $self->Get('WebDefaultStylesheet');
-
- my @comp_roots = RT::Interface::Web->ComponentRoots;
- for my $comp_root (@comp_roots) {
- return if -d $comp_root.'/NoAuth/css/'.$value;
- }
-
- $RT::Logger->warning(
- "The default stylesheet ($value) does not exist in this instance of RT. "
- . "Defaulting to freeside3."
- );
-
- #$self->Set('WebDefaultStylesheet', 'aileron');
- $self->Set('WebDefaultStylesheet', 'freeside3');
- },
- },
- UseSideBySideLayout => {
- Section => 'Ticket composition',
- Overridable => 1,
- SortOrder => 5,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Use a two column layout for create and update forms?' # loc
- }
- },
- MessageBoxRichText => {
- Section => 'Ticket composition',
- Overridable => 1,
- SortOrder => 5.1,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'WYSIWYG message composer' # loc
- }
- },
- MessageBoxRichTextHeight => {
- Section => 'Ticket composition',
- Overridable => 1,
- SortOrder => 6,
- Widget => '/Widgets/Form/Integer',
- WidgetArguments => {
- Description => 'WYSIWYG composer height', # loc
- }
- },
- MessageBoxWidth => {
- Section => 'Ticket composition',
- Overridable => 1,
- SortOrder => 7,
- Widget => '/Widgets/Form/Integer',
- WidgetArguments => {
- Description => 'Message box width', #loc
- },
- },
- MessageBoxHeight => {
- Section => 'Ticket composition',
- Overridable => 1,
- SortOrder => 8,
- Widget => '/Widgets/Form/Integer',
- WidgetArguments => {
- Description => 'Message box height', #loc
- },
- },
- MessageBoxWrap => {
- Section => 'Ticket composition', #loc
- Overridable => 1,
- SortOrder => 8.1,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Message box wrapping', #loc
- Values => [qw(SOFT HARD)],
- Hints => "When the WYSIWYG editor is not enabled, this setting determines whether automatic line wraps in the ticket message box are sent to RT or not.", # loc
- },
- },
- DefaultTimeUnitsToHours => {
- Section => 'Ticket composition', #loc
- Overridable => 1,
- SortOrder => 9,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Enter time in hours by default', #loc
- Hints => 'Only for entry, not display', #loc
- },
- },
- SearchResultsRefreshInterval => {
- Section => 'General', #loc
- Overridable => 1,
- SortOrder => 9,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Search results refresh interval', #loc
- Values => [qw(0 120 300 600 1200 3600 7200)],
- ValuesLabel => {
- 0 => "Don't refresh search results.", #loc
- 120 => "Refresh search results every 2 minutes.", #loc
- 300 => "Refresh search results every 5 minutes.", #loc
- 600 => "Refresh search results every 10 minutes.", #loc
- 1200 => "Refresh search results every 20 minutes.", #loc
- 3600 => "Refresh search results every 60 minutes.", #loc
- 7200 => "Refresh search results every 120 minutes.", #loc
- },
- },
- },
-
- # User overridable options for RT at a glance
- HomePageRefreshInterval => {
- Section => 'RT at a glance', #loc
- Overridable => 1,
- SortOrder => 2,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Home page refresh interval', #loc
- Values => [qw(0 120 300 600 1200 3600 7200)],
- ValuesLabel => {
- 0 => "Don't refresh home page.", #loc
- 120 => "Refresh home page every 2 minutes.", #loc
- 300 => "Refresh home page every 5 minutes.", #loc
- 600 => "Refresh home page every 10 minutes.", #loc
- 1200 => "Refresh home page every 20 minutes.", #loc
- 3600 => "Refresh home page every 60 minutes.", #loc
- 7200 => "Refresh home page every 120 minutes.", #loc
- },
- },
- },
-
- # User overridable options for Ticket displays
- MaxInlineBody => {
- Section => 'Ticket display', #loc
- Overridable => 1,
- SortOrder => 1,
- Widget => '/Widgets/Form/Integer',
- WidgetArguments => {
- Description => 'Maximum inline message length', #loc
- Hints =>
- "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
- },
- },
- OldestTransactionsFirst => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 2,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Show oldest history first', #loc
- },
- },
- DeferTransactionLoading => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 3,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Hide ticket history by default', #loc
- },
- },
- ShowUnreadMessageNotifications => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 4,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Notify me of unread messages', #loc
- },
-
- },
- PlainTextPre => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 5,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'add <pre> tag around plain text attachments', #loc
- Hints => "Use this to protect the format of plain text" #loc
- },
- },
- PlainTextMono => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 5,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'display wrapped and formatted plain text attachments', #loc
- Hints => 'Use css rules to display text monospaced and with formatting preserved, but wrap as needed. This does not work well with IE6 and you should use the previous option', #loc
- },
- },
- DisplayAfterQuickCreate => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 6,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'On Quick Create, redirect to ticket display', #loc
- #Hints => '', #loc
- },
- },
- MoreAboutRequestorTicketList => {
- Section => 'Ticket display', #loc
- Overridable => 1,
- SortOrder => 6,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => q|What tickets to display in the 'More about requestor' box|, #loc
- Values => [qw(Active Inactive All None)],
- ValuesLabel => {
- Active => "Show the Requestor's 10 highest priority active tickets", #loc
- Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc
- All => "Show the Requestor's 10 highest priority tickets", #loc
- None => "Show no tickets for the Requestor", #loc
- },
- },
- },
- SimplifiedRecipients => {
- Section => 'Ticket display', #loc
- Overridable => 1,
- SortOrder => 7,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => q|Show simplified recipient list on ticket update|, #loc
- },
- },
- DisplayTicketAfterQuickCreate => {
- Section => 'Ticket display',
- Overridable => 1,
- SortOrder => 8,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => q{Display ticket after "Quick Create"}, #loc
- },
- },
-
- # User overridable locale options
- DateTimeFormat => {
- Section => 'Locale', #loc
- Overridable => 1,
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Date format', #loc
- Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
- my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'});
- $date->SetToNow;
- foreach my $value ($date->Formatters) {
- push @{$ret->{Values}}, $value;
- $ret->{ValuesLabel}{$value} = $date->Get(
- Format => $value,
- Timezone => 'user',
- );
- }
- return $ret;
- },
- },
- },
-
- RTAddressRegexp => {
- Type => 'SCALAR',
- PostLoadCheck => sub {
- my $self = shift;
- my $value = $self->Get('RTAddressRegexp');
- if (not $value) {
- $RT::Logger->debug(
- 'The RTAddressRegexp option is not set in the config.'
- .' Not setting this option results in additional SQL queries to'
- .' check whether each address belongs to RT or not.'
- .' It is especially important to set this option if RT recieves'
- .' emails on addresses that are not in the database or config.'
- );
- } elsif (ref $value and ref $value eq "Regexp") {
- # Ensure that the regex is case-insensitive; while the
- # local part of email addresses is _technically_
- # case-sensitive, most MTAs don't treat it as such.
- $RT::Logger->warning(
- 'RTAddressRegexp is set to a case-sensitive regular expression.'
- .' This may lead to mail loops with MTAs which treat the'
- .' local part as case-insensitive -- which is most of them.'
- ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/;
- }
- },
- },
- # User overridable mail options
- EmailFrequency => {
- Section => 'Mail', #loc
- Overridable => 1,
- Default => 'Individual messages',
- Widget => '/Widgets/Form/Select',
- WidgetArguments => {
- Description => 'Email delivery', #loc
- Values => [
- 'Individual messages', #loc
- 'Daily digest', #loc
- 'Weekly digest', #loc
- 'Suspended' #loc
- ]
- }
- },
- NotifyActor => {
- Section => 'Mail', #loc
- Overridable => 1,
- SortOrder => 2,
- Widget => '/Widgets/Form/Boolean',
- WidgetArguments => {
- Description => 'Outgoing mail', #loc
- Hints => 'Should RT send you mail for ticket updates you make?', #loc
- }
- },
-
- # this tends to break extensions that stash links in ticket update pages
- Organization => {
- Type => 'SCALAR',
- PostLoadCheck => sub {
- my ($self,$value) = @_;
- $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.")
- if $value =~ /\s/;;
- },
- },
-
- # Internal config options
- FullTextSearch => {
- Type => 'HASH',
- PostLoadCheck => sub {
- my $self = shift;
- my $v = $self->Get('FullTextSearch');
- return unless $v->{Enable} and $v->{Indexed};
- my $dbtype = $self->Get('DatabaseType');
- if ($dbtype eq 'Oracle') {
- if (not $v->{IndexName}) {
- $RT::Logger->error("No IndexName set for full-text index; disabling");
- $v->{Enable} = $v->{Indexed} = 0;
- }
- } elsif ($dbtype eq 'Pg') {
- my $bad = 0;
- if (not $v->{'Column'}) {
- $RT::Logger->error("No Column set for full-text index; disabling");
- $v->{Enable} = $v->{Indexed} = 0;
- } elsif ($v->{'Column'} eq "Content"
- and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) {
- $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling");
- $v->{Enable} = $v->{Indexed} = 0;
- }
- } elsif ($dbtype eq 'mysql') {
- if (not $v->{'Table'}) {
- $RT::Logger->error("No Table set for full-text index; disabling");
- $v->{Enable} = $v->{Indexed} = 0;
- } elsif ($v->{'Table'} eq "Attachments") {
- $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling");
- $v->{Enable} = $v->{Indexed} = 0;
- } elsif (not $v->{'MaxMatches'}) {
- $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000");
- $v->{MaxMatches} = 10_000;
- }
- } else {
- $RT::Logger->error("Indexed full-text-search not supported for $dbtype");
- $v->{Indexed} = 0;
- }
- },
- },
- DisableGraphViz => {
- Type => 'SCALAR',
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
- return if $value;
- return if $INC{'GraphViz.pm'};
- local $@;
- return if eval {require GraphViz; 1};
- $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
- $self->Set( DisableGraphViz => 1 );
- },
- },
- DisableGD => {
- Type => 'SCALAR',
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
- return if $value;
- return if $INC{'GD.pm'};
- local $@;
- return if eval {require GD; 1};
- $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
- $self->Set( DisableGD => 1 );
- },
- },
- MailPlugins => { Type => 'ARRAY' },
- Plugins => {
- Type => 'ARRAY',
- PostLoadCheck => sub {
- my $self = shift;
- my $value = $self->Get('Plugins');
- # XXX Remove in RT 4.2
- return unless $value and grep {$_ eq "RT::FM"} @{$value};
- warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins';
- },
- },
- GnuPG => { Type => 'HASH' },
- GnuPGOptions => { Type => 'HASH',
- PostLoadCheck => sub {
- my $self = shift;
- my $gpg = $self->Get('GnuPG');
- return unless $gpg->{'Enable'};
- my $gpgopts = $self->Get('GnuPGOptions');
- unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg
- $RT::Logger->debug(
- "RT's GnuPG libraries couldn't successfully read your".
- " configured GnuPG home directory (".$gpgopts->{homedir}
- ."). PGP support has been disabled");
- $gpg->{'Enable'} = 0;
- return;
- }
-
-
- require RT::Crypt::GnuPG;
- unless (RT::Crypt::GnuPG->Probe()) {
- $RT::Logger->debug(
- "RT's GnuPG libraries couldn't successfully execute gpg.".
- " PGP support has been disabled");
- $gpg->{'Enable'} = 0;
- }
- }
- },
- ReferrerWhitelist => { Type => 'ARRAY' },
- ResolveDefaultUpdateType => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
- return unless $value;
- $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated. '.
- 'You can change the site default in your %Lifecycles config.');
- }
- },
- WebPath => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
-
- # "In most cases, you should leave $WebPath set to '' (an empty value)."
- return unless $value;
-
- # try to catch someone who assumes that you shouldn't leave this empty
- if ($value eq '/') {
- $RT::Logger->error("For the WebPath config option, use the empty string instead of /");
- return;
- }
-
- # $WebPath requires a leading / but no trailing /, or it can be blank.
- return if $value =~ m{^/.+[^/]$};
-
- if ($value =~ m{/$}) {
- $RT::Logger->error("The WebPath config option requires no trailing slash");
- }
-
- if ($value !~ m{^/}) {
- $RT::Logger->error("The WebPath config option requires a leading slash");
- }
- },
- },
- WebDomain => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
-
- if (!$value) {
- $RT::Logger->error("You must set the WebDomain config option");
- return;
- }
-
- if ($value =~ m{^(\w+://)}) {
- $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)");
- return;
- }
-
- if ($value =~ m{(/.*)}) {
- $RT::Logger->error("The WebDomain config option must not contain a path ($1)");
- return;
- }
-
- if ($value =~ m{:(\d*)}) {
- $RT::Logger->error("The WebDomain config option must not contain a port ($1)");
- return;
- }
- },
- },
- WebPort => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
-
- if (!$value) {
- $RT::Logger->error("You must set the WebPort config option");
- return;
- }
-
- if ($value !~ m{^\d+$}) {
- $RT::Logger->error("The WebPort config option must be an integer");
- }
- },
- },
- WebBaseURL => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
-
- if (!$value) {
- $RT::Logger->error("You must set the WebBaseURL config option");
- return;
- }
-
- if ($value !~ m{^https?://}i) {
- $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)");
- }
-
- if ($value =~ m{/$}) {
- $RT::Logger->error("The WebBaseURL config option requires no trailing slash");
- }
-
- if ($value =~ m{^https?://.+?(/[^/].*)}i) {
- $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)");
- }
- },
- },
- WebURL => {
- PostLoadCheck => sub {
- my $self = shift;
- my $value = shift;
-
- if (!$value) {
- $RT::Logger->error("You must set the WebURL config option");
- return;
- }
-
- if ($value !~ m{^https?://}i) {
- $RT::Logger->error("The WebURL config option must contain a scheme (http or https)");
- }
-
- if ($value !~ m{/$}) {
- $RT::Logger->error("The WebURL config option requires a trailing slash");
- }
- },
- },
- EmailInputEncodings => {
- Type => 'ARRAY',
- PostLoadCheck => sub {
- my $self = shift;
- my $value = $self->Get('EmailInputEncodings');
- return unless $value && @$value;
-
- my %seen;
- foreach my $encoding ( grep defined && length, splice @$value ) {
- next if $seen{ $encoding };
- if ( $encoding eq '*' ) {
- unshift @$value, '*';
- next;
- }
-
- my $canonic = Encode::resolve_alias( $encoding );
- unless ( $canonic ) {
- warn "Unknown encoding '$encoding' in \@EmailInputEncodings option";
- }
- elsif ( $seen{ $canonic }++ ) {
- next;
- }
- else {
- push @$value, $canonic;
- }
- }
- },
- },
-
- ActiveStatus => {
- Type => 'ARRAY',
- PostLoadCheck => sub {
- my $self = shift;
- return unless shift;
- # XXX Remove in RT 4.2
- warn <<EOT;
-The ActiveStatus configuration has been replaced by the new Lifecycles
-functionality. You should set the 'active' property of the 'default'
-lifecycle and add transition rules; see RT_Config.pm for documentation.
-EOT
- },
- },
- InactiveStatus => {
- Type => 'ARRAY',
- PostLoadCheck => sub {
- my $self = shift;
- return unless shift;
- # XXX Remove in RT 4.2
- warn <<EOT;
-The InactiveStatus configuration has been replaced by the new Lifecycles
-functionality. You should set the 'inactive' property of the 'default'
-lifecycle and add transition rules; see RT_Config.pm for documentation.
-EOT
- },
- },
-);
-my %OPTIONS = ();
-
-=head1 METHODS
-
-=head2 new
-
-Object constructor returns new object. Takes no arguments.
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) ? ref($proto) : $proto;
- my $self = bless {}, $class;
- $self->_Init(@_);
- return $self;
-}
-
-sub _Init {
- return;
-}
-
-=head2 InitConfig
-
-Do nothin right now.
-
-=cut
-
-sub InitConfig {
- my $self = shift;
- my %args = ( File => '', @_ );
- $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
- return 1;
-}
-
-=head2 LoadConfigs
-
-Load all configs. First of all load RT's config then load
-extensions' config files in alphabetical order.
-Takes no arguments.
-
-=cut
-
-sub LoadConfigs {
- my $self = shift;
-
- $self->InitConfig( File => 'RT_Config.pm' );
- $self->LoadConfig( File => 'RT_Config.pm' );
-
- my @configs = $self->Configs;
- $self->InitConfig( File => $_ ) foreach @configs;
- $self->LoadConfig( File => $_ ) foreach @configs;
- return;
-}
-
-=head1 LoadConfig
-
-Takes param hash with C<File> field.
-First, the site configuration file is loaded, in order to establish
-overall site settings like hostname and name of RT instance.
-Then, the core configuration file is loaded to set fallback values
-for all settings; it bases some values on settings from the site
-configuration file.
-
-B<Note> that core config file don't change options if site config
-has set them so to add value to some option instead of
-overriding you have to copy original value from core config file.
-
-=cut
-
-sub LoadConfig {
- my $self = shift;
- my %args = ( File => '', @_ );
- $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
- if ( $args{'File'} eq 'RT_SiteConfig.pm'
- and my $site_config = $ENV{RT_SITE_CONFIG} )
- {
- $self->_LoadConfig( %args, File => $site_config );
- } else {
- $self->_LoadConfig(%args);
- }
- $args{'File'} =~ s/Site(?=Config\.pm$)//;
- $self->_LoadConfig(%args);
- return 1;
-}
-
-sub _LoadConfig {
- my $self = shift;
- my %args = ( File => '', @_ );
-
- my ($is_ext, $is_site);
- if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
- ($is_ext, $is_site) = ('', 1);
- } else {
- $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
- $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
- }
-
- eval {
- package RT;
- local *Set = sub(\[$@%]@) {
- my ( $opt_ref, @args ) = @_;
- my ( $pack, $file, $line ) = caller;
- return $self->SetFromConfig(
- Option => $opt_ref,
- Value => [@args],
- Package => $pack,
- File => $file,
- Line => $line,
- SiteConfig => $is_site,
- Extension => $is_ext,
- );
- };
- my @etc_dirs = ($RT::LocalEtcPath);
- push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
- push @etc_dirs, $RT::EtcPath, @INC;
- local @INC = @etc_dirs;
- require $args{'File'};
- };
- if ($@) {
- return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/;
- if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) {
- die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
- }
-
- my $username = getpwuid($>);
- my $group = getgrgid($();
-
- my ( $file_path, $fileuid, $filegid );
- foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
- my $tmp = File::Spec->catfile( $_, $args{File} );
- ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
- if ( defined $fileuid ) {
- $file_path = $tmp;
- last;
- }
- }
- unless ($file_path) {
- die
- qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
- . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
- }
-
- my $message = <<EOF;
-
-RT couldn't load RT config file %s as:
- user: $username
- group: $group
-
-The file is owned by user %s and group %s.
-
-This usually means that the user/group your webserver is running
-as cannot read the file. Be careful not to make the permissions
-on this file too liberal, because it contains database passwords.
-You may need to put the webserver user in the appropriate group
-(%s) or change permissions be able to run succesfully.
-EOF
-
- my $fileusername = getpwuid($fileuid);
- my $filegroup = getgrgid($filegid);
- my $errormessage = sprintf( $message,
- $file_path, $fileusername, $filegroup, $filegroup );
- die "$errormessage\n$@";
- }
- return 1;
-}
-
-sub PostLoadCheck {
- my $self = shift;
- foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
- $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
- }
-}
-
-=head2 Configs
-
-Returns list of config files found in local etc, plugins' etc
-and main etc directories.
-
-=cut
-
-sub Configs {
- my $self = shift;
-
- my @configs = ();
- foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
- my $mask = File::Spec->catfile( $path, "*_Config.pm" );
- my @files = glob $mask;
- @files = grep !/^RT_Config\.pm$/,
- grep $_ && /^\w+_Config\.pm$/,
- map { s/^.*[\\\/]//; $_ } @files;
- push @configs, sort @files;
- }
-
- my %seen;
- @configs = grep !$seen{$_}++, @configs;
- return @configs;
-}
-
-=head2 Get
-
-Takes name of the option as argument and returns its current value.
-
-In the case of a user-overridable option, first checks the user's
-preferences before looking for site-wide configuration.
-
-Returns values from RT_SiteConfig, RT_Config and then the %META hash
-of configuration variables's "Default" for this config variable,
-in that order.
-
-Returns different things in scalar and array contexts. For scalar
-options it's not that important, however for arrays and hash it's.
-In scalar context returns references to arrays and hashes.
-
-Use C<scalar> perl's op to force context, especially when you use
-C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
-as perl's '=>' op doesn't change context of the right hand argument to
-scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
-
-It's also important for options that have no default value(no default
-in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
-get empty list and all your named args will be messed up. For example
-C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
-will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
-unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
-will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
-
-=cut
-
-sub Get {
- my ( $self, $name, $user ) = @_;
-
- my $res;
- if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
- $user = $user->UserObj if $user->isa('RT::CurrentUser');
- my $prefs = $user->Preferences($RT::System);
- $res = $prefs->{$name} if $prefs;
- }
- $res = $OPTIONS{$name} unless defined $res;
- $res = $META{$name}->{'Default'} unless defined $res;
- return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
-}
-
-=head2 GetObfuscated
-
-the same as Get, except it returns Obfuscated value via Obfuscate sub
-
-=cut
-
-sub GetObfuscated {
- my $self = shift;
- my ( $name, $user ) = @_;
- my $obfuscate = $META{$name}->{Obfuscate};
-
- # we use two Get here is to simplify the logic of the return value
- # configs need obfuscation are supposed to be less, so won't be too heavy
-
- return $self->Get(@_) unless $obfuscate;
-
- my $res = $self->Get(@_);
- $res = $obfuscate->( $self, $res, $user );
- return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
-}
-
-=head2 Set
-
-Set option's value to new value. Takes name of the option and new value.
-Returns old value.
-
-The new value should be scalar, array or hash depending on type of the option.
-If the option is not defined in meta or the default RT config then it is of
-scalar type.
-
-=cut
-
-sub Set {
- my ( $self, $name ) = ( shift, shift );
-
- my $old = $OPTIONS{$name};
- my $type = $META{$name}->{'Type'} || 'SCALAR';
- if ( $type eq 'ARRAY' ) {
- $OPTIONS{$name} = [@_];
- { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
- } elsif ( $type eq 'HASH' ) {
- $OPTIONS{$name} = {@_};
- { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
- } else {
- $OPTIONS{$name} = shift;
- {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
- }
- $META{$name}->{'Type'} = $type;
- return $self->_ReturnValue( $old, $type );
-}
-
-sub _ReturnValue {
- my ( $self, $res, $type ) = @_;
- return $res unless wantarray;
-
- if ( $type eq 'ARRAY' ) {
- return @{ $res || [] };
- } elsif ( $type eq 'HASH' ) {
- return %{ $res || {} };
- }
- return $res;
-}
-
-sub SetFromConfig {
- my $self = shift;
- my %args = (
- Option => undef,
- Value => [],
- Package => 'RT',
- File => '',
- Line => 0,
- SiteConfig => 1,
- Extension => 0,
- @_
- );
-
- unless ( $args{'File'} ) {
- ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
- }
-
- my $opt = $args{'Option'};
-
- my $type;
- my $name = $self->__GetNameByRef($opt);
- if ($name) {
- $type = ref $opt;
- $name =~ s/.*:://;
- } else {
- $name = $$opt;
- $type = $META{$name}->{'Type'} || 'SCALAR';
- }
-
- # if option is already set we have to check where
- # it comes from and may be ignore it
- if ( exists $OPTIONS{$name} ) {
- if ( $type eq 'HASH' ) {
- $args{'Value'} = [
- @{ $args{'Value'} },
- @{ $args{'Value'} }%2? (undef) : (),
- $self->Get( $name ),
- ];
- } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) {
- # if it's site config of an extension then it can only
- # override options that came from its main config
- if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
- my %source = %{ $META{$name}->{'Source'} };
- warn
- "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
- ." This option earlier has been set in $source{'File'} line $source{'Line'}."
- ." To overide this option use ". ($source{'Extension'}||'RT')
- ." site config."
- ;
- return 1;
- }
- } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
- # if it's core config then we can override any option that came from another
- # core config, but not site config
-
- my %source = %{ $META{$name}->{'Source'} };
- if ( $source{'Extension'} ne $args{'Extension'} ) {
- # as a site config is loaded earlier then its base config
- # then we warn only on different extensions, for example
- # RTIR's options is set in main site config
- warn
- "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
- ." It may be ok, but we want you to be aware."
- ." This option has been set earlier in $source{'File'} line $source{'Line'}."
- ;
- }
-
- return 1;
- }
- }
-
- $META{$name}->{'Type'} = $type;
- foreach (qw(Package File Line SiteConfig Extension)) {
- $META{$name}->{'Source'}->{$_} = $args{$_};
- }
- $self->Set( $name, @{ $args{'Value'} } );
-
- return 1;
-}
-
- our %REF_SYMBOLS = (
- SCALAR => '$',
- ARRAY => '@',
- HASH => '%',
- CODE => '&',
- );
-
-{
- my $last_pack = '';
-
- sub __GetNameByRef {
- my $self = shift;
- my $ref = shift;
- my $pack = shift;
- if ( !$pack && $last_pack ) {
- my $tmp = $self->__GetNameByRef( $ref, $last_pack );
- return $tmp if $tmp;
- }
- $pack ||= 'main::';
- $pack .= '::' unless substr( $pack, -2 ) eq '::';
-
- no strict 'refs';
- my $name = undef;
-
- # scan $pack's nametable(hash)
- foreach my $k ( keys %{$pack} ) {
-
- # The hash for main:: has a reference to itself
- next if $k eq 'main::';
-
- # if the entry has a trailing '::' then
- # it is a link to another name space
- if ( substr( $k, -2 ) eq '::') {
- $name = $self->__GetNameByRef( $ref, $pack eq 'main::'? $k : $pack.$k );
- return $name if $name;
- }
-
- # entry of the table with references to
- # SCALAR, ARRAY... and other types with
- # the same name
- my $entry = ${$pack}{$k};
- next unless $entry;
-
- # Inlined constants are simplified in the symbol table --
- # namely, when possible, you only get a reference back in
- # $entry, rather than a full GLOB. In 5.10, scalar
- # constants began being inlined this way; starting in 5.20,
- # list constants are also inlined. Notably, ref(GLOB) is
- # undef, but inlined constants are currently either REF,
- # SCALAR, or ARRAY.
- next if ref($entry);
-
- my $ref_type = ref($ref);
-
- # regex/arrayref/hashref/coderef are stored in SCALAR glob
- $ref_type = 'SCALAR' if $ref_type eq 'REF';
-
- my $entry_ref = *{$entry}{ $ref_type };
- next if ref $entry_ref && ref $entry_ref ne ref $ref;
- next unless $entry_ref;
-
- # if references are equal then we've found
- if ( $entry_ref == $ref ) {
- $last_pack = $pack;
- return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k;
- }
- }
- return '';
- }
-}
-
-=head2 Metadata
-
-
-=head2 Meta
-
-=cut
-
-sub Meta {
- return $META{ $_[1] };
-}
-
-sub Sections {
- my $self = shift;
- my %seen;
- my @sections = sort
- grep !$seen{$_}++,
- map $_->{'Section'} || 'General',
- values %META;
- return @sections;
-}
-
-sub Options {
- my $self = shift;
- my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
- my @res = keys %META;
-
- @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
- @res
- ) if defined $args{'Section'};
-
- if ( defined $args{'Overridable'} ) {
- @res
- = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
- @res );
- }
-
- if ( $args{'Sorted'} ) {
- @res = sort {
- ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
- || $a cmp $b
- } @res;
- } else {
- @res = sort { $a cmp $b } @res;
- }
- return @res;
-}
-
-=head2 AddOption( Name => '', Section => '', ... )
-
-=cut
-
-sub AddOption {
- my $self = shift;
- my %args = (
- Name => undef,
- Section => undef,
- Overridable => 0,
- SortOrder => undef,
- Widget => '/Widgets/Form/String',
- WidgetArguments => {},
- @_
- );
-
- unless ( $args{Name} ) {
- $RT::Logger->error("Need Name to add a new config");
- return;
- }
-
- unless ( $args{Section} ) {
- $RT::Logger->error("Need Section to add a new config option");
- return;
- }
-
- $META{ delete $args{Name} } = \%args;
-}
-
-=head2 DeleteOption( Name => '' )
-
-=cut
-
-sub DeleteOption {
- my $self = shift;
- my %args = (
- Name => undef,
- @_
- );
- if ( $args{Name} ) {
- delete $META{$args{Name}};
- }
- else {
- $RT::Logger->error("Need Name to remove a config option");
- return;
- }
-}
-
-=head2 UpdateOption( Name => '' ), Section => '', ... )
-
-=cut
-
-sub UpdateOption {
- my $self = shift;
- my %args = (
- Name => undef,
- Section => undef,
- Overridable => undef,
- SortOrder => undef,
- Widget => undef,
- WidgetArguments => undef,
- @_
- );
-
- my $name = delete $args{Name};
-
- unless ( $name ) {
- $RT::Logger->error("Need Name to update a new config");
- return;
- }
-
- unless ( exists $META{$name} ) {
- $RT::Logger->error("Config $name doesn't exist");
- return;
- }
-
- for my $type ( keys %args ) {
- next unless defined $args{$type};
- $META{$name}{$type} = $args{$type};
- }
- return 1;
-}
-
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::CustomField;
-
-use strict;
-use warnings;
-
-use Scalar::Util 'blessed';
-
-use base 'RT::Record';
-
-sub Table {'CustomFields'}
-
-
-use RT::CustomFieldValues;
-use RT::ObjectCustomFields;
-use RT::ObjectCustomFieldValues;
-
-our %FieldTypes = (
- Select => {
- sort_order => 10,
- selection_type => 1,
-
- labels => [ 'Select multiple values', # loc
- 'Select one value', # loc
- 'Select up to [_1] values', # loc
- ],
-
- render_types => {
- multiple => [
-
- # Default is the first one
- 'Select box', # loc
- 'List', # loc
- ],
- single => [ 'Select box', # loc
- 'Dropdown', # loc
- 'List', # loc
- ]
- },
-
- },
- Freeform => {
- sort_order => 20,
- selection_type => 0,
-
- labels => [ 'Enter multiple values', # loc
- 'Enter one value', # loc
- 'Enter up to [_1] values', # loc
- ]
- },
- Text => {
- sort_order => 30,
- selection_type => 0,
- labels => [
- 'Fill in multiple text areas', # loc
- 'Fill in one text area', # loc
- 'Fill in up to [_1] text areas', # loc
- ]
- },
- Wikitext => {
- sort_order => 40,
- selection_type => 0,
- labels => [
- 'Fill in multiple wikitext areas', # loc
- 'Fill in one wikitext area', # loc
- 'Fill in up to [_1] wikitext areas', # loc
- ]
- },
-
- Image => {
- sort_order => 50,
- selection_type => 0,
- labels => [
- 'Upload multiple images', # loc
- 'Upload one image', # loc
- 'Upload up to [_1] images', # loc
- ]
- },
- Binary => {
- sort_order => 60,
- selection_type => 0,
- labels => [
- 'Upload multiple files', # loc
- 'Upload one file', # loc
- 'Upload up to [_1] files', # loc
- ]
- },
-
- Combobox => {
- sort_order => 70,
- selection_type => 1,
- labels => [
- 'Combobox: Select or enter multiple values', # loc
- 'Combobox: Select or enter one value', # loc
- 'Combobox: Select or enter up to [_1] values', # loc
- ]
- },
- Autocomplete => {
- sort_order => 80,
- selection_type => 1,
- labels => [
- 'Enter multiple values with autocompletion', # loc
- 'Enter one value with autocompletion', # loc
- 'Enter up to [_1] values with autocompletion', # loc
- ]
- },
-
- Date => {
- sort_order => 90,
- selection_type => 0,
- labels => [
- 'Select multiple dates', # loc
- 'Select date', # loc
- 'Select up to [_1] dates', # loc
- ]
- },
- DateTime => {
- sort_order => 100,
- selection_type => 0,
- labels => [
- 'Select multiple datetimes', # loc
- 'Select datetime', # loc
- 'Select up to [_1] datetimes', # loc
- ]
- },
- TimeValue => {
- sort_order => 105,
- selection_type => 0,
- labels => [
- 'Enter multiple time values (UNSUPPORTED)',
- 'Enter a time value',
- 'Enter [_1] time values (UNSUPPORTED)',
- ]
- },
-
- IPAddress => {
- sort_order => 110,
- selection_type => 0,
-
- labels => [ 'Enter multiple IP addresses', # loc
- 'Enter one IP address', # loc
- 'Enter up to [_1] IP addresses', # loc
- ]
- },
- IPAddressRange => {
- sort_order => 120,
- selection_type => 0,
-
- labels => [ 'Enter multiple IP address ranges', # loc
- 'Enter one IP address range', # loc
- 'Enter up to [_1] IP address ranges', # loc
- ]
- },
-);
-
-
-our %FRIENDLY_OBJECT_TYPES = ();
-
-RT::CustomField->_ForObjectType( 'RT::Queue-RT::Ticket' => "Tickets", ); #loc
-RT::CustomField->_ForObjectType(
- 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", ); #loc
-RT::CustomField->_ForObjectType( 'RT::User' => "Users", ); #loc
-RT::CustomField->_ForObjectType( 'RT::Queue' => "Queues", ); #loc
-RT::CustomField->_ForObjectType( 'RT::Group' => "Groups", ); #loc
-
-our $RIGHTS = {
- SeeCustomField => 'View custom fields', # loc_pair
- AdminCustomField => 'Create, modify and delete custom fields', # loc_pair
- AdminCustomFieldValues => 'Create, modify and delete custom fields values', # loc_pair
- ModifyCustomField => 'Add, modify and delete custom field values for objects' # loc_pair
-};
-
-our $RIGHT_CATEGORIES = {
- SeeCustomField => 'General',
- AdminCustomField => 'Admin',
- AdminCustomFieldValues => 'Admin',
- ModifyCustomField => 'Staff',
-};
-
-# Tell RT::ACE that this sort of object can get acls granted
-$RT::ACE::OBJECT_TYPES{'RT::CustomField'} = 1;
-
-__PACKAGE__->AddRights(%$RIGHTS);
-__PACKAGE__->AddRightCategories(%$RIGHT_CATEGORIES);
-
-=head2 AddRights C<RIGHT>, C<DESCRIPTION> [, ...]
-
-Adds the given rights to the list of possible rights. This method
-should be called during server startup, not at runtime.
-
-=cut
-
-sub AddRights {
- my $self = shift;
- my %new = @_;
- $RIGHTS = { %$RIGHTS, %new };
- %RT::ACE::LOWERCASERIGHTNAMES = ( %RT::ACE::LOWERCASERIGHTNAMES,
- map { lc($_) => $_ } keys %new);
-}
-
-sub AvailableRights {
- my $self = shift;
- return $RIGHTS;
-}
-
-=head2 RightCategories
-
-Returns a hashref where the keys are rights for this type of object and the
-values are the category (General, Staff, Admin) the right falls into.
-
-=cut
-
-sub RightCategories {
- return $RIGHT_CATEGORIES;
-}
-
-=head2 AddRightCategories C<RIGHT>, C<CATEGORY> [, ...]
-
-Adds the given right and category pairs to the list of right categories. This
-method should be called during server startup, not at runtime.
-
-=cut
-
-sub AddRightCategories {
- my $self = shift if ref $_[0] or $_[0] eq __PACKAGE__;
- my %new = @_;
- $RIGHT_CATEGORIES = { %$RIGHT_CATEGORIES, %new };
-}
-
-=head1 NAME
-
- RT::CustomField_Overlay - overlay for RT::CustomField
-
-=head1 DESCRIPTION
-
-=head1 'CORE' METHODS
-
-=head2 Create PARAMHASH
-
-Create takes a hash of values and creates a row in the database:
-
- varchar(200) 'Name'.
- varchar(200) 'Type'.
- int(11) 'MaxValues'.
- varchar(255) 'Pattern'.
- smallint(6) 'Repeated'.
- varchar(255) 'Description'.
- int(11) 'SortOrder'.
- varchar(255) 'LookupType'.
- smallint(6) 'Disabled'.
-
-C<LookupType> is generally the result of either
-C<RT::Ticket->CustomFieldLookupType> or C<RT::Transaction->CustomFieldLookupType>.
-
-=cut
-
-sub Create {
- my $self = shift;
- my %args = (
- Name => '',
- Type => '',
- MaxValues => 0,
- Pattern => '',
- Description => '',
- Disabled => 0,
- LookupType => '',
- Repeated => 0,
- LinkValueTo => '',
- IncludeContentForValue => '',
- @_,
- );
-
- unless ( $self->CurrentUser->HasRight(Object => $RT::System, Right => 'AdminCustomField') ) {
- return (0, $self->loc('Permission Denied'));
- }
-
- if ( $args{TypeComposite} ) {
- @args{'Type', 'MaxValues'} = split(/-/, $args{TypeComposite}, 2);
- }
- elsif ( $args{Type} =~ s/(?:(Single)|Multiple)$// ) {
- # old style Type string
- $args{'MaxValues'} = $1 ? 1 : 0;
- }
- $args{'MaxValues'} = int $args{'MaxValues'};
-
- if ( !exists $args{'Queue'}) {
- # do nothing -- things below are strictly backward compat
- }
- elsif ( ! $args{'Queue'} ) {
- unless ( $self->CurrentUser->HasRight( Object => $RT::System, Right => 'AssignCustomFields') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- $args{'LookupType'} = 'RT::Queue-RT::Ticket';
- }
- else {
- my $queue = RT::Queue->new($self->CurrentUser);
- $queue->Load($args{'Queue'});
- unless ($queue->Id) {
- return (0, $self->loc("Queue not found"));
- }
- unless ( $queue->CurrentUserHasRight('AssignCustomFields') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- $args{'LookupType'} = 'RT::Queue-RT::Ticket';
- $args{'Queue'} = $queue->Id;
- }
-
- my ($ok, $msg) = $self->_IsValidRegex( $args{'Pattern'} );
- return (0, $self->loc("Invalid pattern: [_1]", $msg)) unless $ok;
-
- if ( $args{'MaxValues'} != 1 && $args{'Type'} =~ /(text|combobox)$/i ) {
- $RT::Logger->debug("Support for 'multiple' Texts or Comboboxes is not implemented");
- $args{'MaxValues'} = 1;
- }
-
- if ( $args{'RenderType'} ||= undef ) {
- my $composite = join '-', @args{'Type', 'MaxValues'};
- return (0, $self->loc("This custom field has no Render Types"))
- unless $self->HasRenderTypes( $composite );
-
- if ( $args{'RenderType'} eq $self->DefaultRenderType( $composite ) ) {
- $args{'RenderType'} = undef;
- } else {
- return (0, $self->loc("Invalid Render Type") )
- unless grep $_ eq $args{'RenderType'}, $self->RenderTypes( $composite );
- }
- }
-
- $args{'ValuesClass'} = undef if ($args{'ValuesClass'} || '') eq 'RT::CustomFieldValues';
- if ( $args{'ValuesClass'} ||= undef ) {
- return (0, $self->loc("This Custom Field can not have list of values"))
- unless $self->IsSelectionType( $args{'Type'} );
-
- unless ( $self->ValidateValuesClass( $args{'ValuesClass'} ) ) {
- return (0, $self->loc("Invalid Custom Field values source"));
- }
- }
-
- (my $rv, $msg) = $self->SUPER::Create(
- Name => $args{'Name'},
- Type => $args{'Type'},
- RenderType => $args{'RenderType'},
- MaxValues => $args{'MaxValues'},
- Pattern => $args{'Pattern'},
- BasedOn => $args{'BasedOn'},
- ValuesClass => $args{'ValuesClass'},
- Description => $args{'Description'},
- Disabled => $args{'Disabled'},
- LookupType => $args{'LookupType'},
- Repeated => $args{'Repeated'},
- );
-
- if ($rv) {
- if ( exists $args{'LinkValueTo'}) {
- $self->SetLinkValueTo($args{'LinkValueTo'});
- }
-
- if ( exists $args{'IncludeContentForValue'}) {
- $self->SetIncludeContentForValue($args{'IncludeContentForValue'});
- }
-
- if ( exists $args{'UILocation'} ) {
- $self->SetUILocation( $args{'UILocation'} );
- }
-
- if ( exists $args{'NoClone'} ) {
- $self->SetNoClone( $args{'NoClone'} );
- }
-
- return ($rv, $msg) unless exists $args{'Queue'};
-
- # Compat code -- create a new ObjectCustomField mapping
- my $OCF = RT::ObjectCustomField->new( $self->CurrentUser );
- $OCF->Create(
- CustomField => $self->Id,
- ObjectId => $args{'Queue'},
- );
- }
-
- return ($rv, $msg);
-}
-
-=head2 Load ID/NAME
-
-Load a custom field. If the value handed in is an integer, load by custom field ID. Otherwise, Load by name.
-
-=cut
-
-sub Load {
- my $self = shift;
- my $id = shift || '';
-
- if ( $id =~ /^\d+$/ ) {
- return $self->SUPER::Load( $id );
- } else {
- return $self->LoadByName( Name => $id );
- }
-}
-
-
-
-=head2 LoadByName (Queue => QUEUEID, Name => NAME)
-
-Loads the Custom field named NAME.
-
-Will load a Disabled Custom Field even if there is a non-disabled Custom Field
-with the same Name.
-
-If a Queue parameter is specified, only look for ticket custom fields tied to that Queue.
-
-If the Queue parameter is '0', look for global ticket custom fields.
-
-If no queue parameter is specified, look for any and all custom fields with this name.
-
-BUG/TODO, this won't let you specify that you only want user or group CFs.
-
-=cut
-
-# Compatibility for API change after 3.0 beta 1
-*LoadNameAndQueue = \&LoadByName;
-# Change after 3.4 beta.
-*LoadByNameAndQueue = \&LoadByName;
-
-sub LoadByName {
- my $self = shift;
- my %args = (
- Queue => undef,
- Name => undef,
- @_,
- );
-
- unless ( defined $args{'Name'} && length $args{'Name'} ) {
- $RT::Logger->error("Couldn't load Custom Field without Name");
- return wantarray ? (0, $self->loc("No name provided")) : 0;
- }
-
- # if we're looking for a queue by name, make it a number
- if ( defined $args{'Queue'} && ($args{'Queue'} =~ /\D/ || !$self->ContextObject) ) {
- my $QueueObj = RT::Queue->new( $self->CurrentUser );
- $QueueObj->Load( $args{'Queue'} );
- $args{'Queue'} = $QueueObj->Id;
- $self->SetContextObject( $QueueObj )
- unless $self->ContextObject;
- }
-
- # XXX - really naive implementation. Slow. - not really. still just one query
-
- my $CFs = RT::CustomFields->new( $self->CurrentUser );
- $CFs->SetContextObject( $self->ContextObject );
- my $field = $args{'Name'} =~ /\D/? 'Name' : 'id';
- $CFs->Limit( FIELD => $field, VALUE => $args{'Name'}, CASESENSITIVE => 0);
- # Don't limit to queue if queue is 0. Trying to do so breaks
- # RT::Group type CFs.
- if ( defined $args{'Queue'} ) {
- $CFs->LimitToQueue( $args{'Queue'} );
- }
-
- # When loading by name, we _can_ load disabled fields, but prefer
- # non-disabled fields.
- $CFs->FindAllRows;
- $CFs->OrderByCols(
- { FIELD => "Disabled", ORDER => 'ASC' },
- );
-
- # We only want one entry.
- $CFs->RowsPerPage(1);
-
- # version before 3.8 just returns 0, so we need to test if wantarray to be
- # backward compatible.
- return wantarray ? (0, $self->loc("Not found")) : 0 unless my $first = $CFs->First;
-
- return $self->LoadById( $first->id );
-}
-
-
-
-
-=head2 Custom field values
-
-=head3 Values FIELD
-
-Return a object (collection) of all acceptable values for this Custom Field.
-Class of the object can vary and depends on the return value
-of the C<ValuesClass> method.
-
-=cut
-
-*ValuesObj = \&Values;
-
-sub Values {
- my $self = shift;
-
- my $class = $self->ValuesClass;
- if ( $class ne 'RT::CustomFieldValues') {
- eval "require $class" or die "$@";
- }
- my $cf_values = $class->new( $self->CurrentUser );
- # if the user has no rights, return an empty object
- if ( $self->id && $self->CurrentUserHasRight( 'SeeCustomField') ) {
- $cf_values->LimitToCustomField( $self->Id );
- } else {
- $cf_values->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' );
- }
- return ($cf_values);
-}
-
-
-=head3 AddValue HASH
-
-Create a new value for this CustomField. Takes a paramhash containing the elements Name, Description and SortOrder
-
-=cut
-
-sub AddValue {
- my $self = shift;
- my %args = @_;
-
- unless ($self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues')) {
- return (0, $self->loc('Permission Denied'));
- }
-
- # allow zero value
- if ( !defined $args{'Name'} || $args{'Name'} eq '' ) {
- return (0, $self->loc("Can't add a custom field value without a name"));
- }
-
- my $newval = RT::CustomFieldValue->new( $self->CurrentUser );
- return $newval->Create( %args, CustomField => $self->Id );
-}
-
-
-
-
-=head3 DeleteValue ID
-
-Deletes a value from this custom field by id.
-
-Does not remove this value for any article which has had it selected
-
-=cut
-
-sub DeleteValue {
- my $self = shift;
- my $id = shift;
- unless ( $self->CurrentUserHasRight('AdminCustomField') || $self->CurrentUserHasRight('AdminCustomFieldValues') ) {
- return (0, $self->loc('Permission Denied'));
- }
-
- my $val_to_del = RT::CustomFieldValue->new( $self->CurrentUser );
- $val_to_del->Load( $id );
- unless ( $val_to_del->Id ) {
- return (0, $self->loc("Couldn't find that value"));
- }
- unless ( $val_to_del->CustomField == $self->Id ) {
- return (0, $self->loc("That is not a value for this custom field"));
- }
-
- my $retval = $val_to_del->Delete;
- unless ( $retval ) {
- return (0, $self->loc("Custom field value could not be deleted"));
- }
- return ($retval, $self->loc("Custom field value deleted"));
-}
-
-
-=head2 ValidateQueue Queue
-
-Make sure that the name specified is valid
-
-=cut
-
-sub ValidateName {
- my $self = shift;
- my $value = shift;
-
- return 0 unless length $value;
-
- return $self->SUPER::ValidateName($value);
-}
-
-=head2 ValidateQueue Queue
-
-Make sure that the queue specified is a valid queue name
-
-=cut
-
-sub ValidateQueue {
- my $self = shift;
- my $id = shift;
-
- return undef unless defined $id;
- # 0 means "Global" null would _not_ be ok.
- return 1 if $id eq '0';
-
- my $q = RT::Queue->new( RT->SystemUser );
- $q->Load( $id );
- return undef unless $q->id;
- return 1;
-}
-
-
-
-=head2 Types
-
-Retuns an array of the types of CustomField that are supported
-
-=cut
-
-sub Types {
- return (sort {(($FieldTypes{$a}{sort_order}||999) <=> ($FieldTypes{$b}{sort_order}||999)) or ($a cmp $b)} keys %FieldTypes);
-}
-
-
-=head2 IsSelectionType
-
-Retuns a boolean value indicating whether the C<Values> method makes sense
-to this Custom Field.
-
-=cut
-
-sub IsSelectionType {
- my $self = shift;
- my $type = @_? shift : $self->Type;
- return undef unless $type;
- return $FieldTypes{$type}->{selection_type};
-}
-
-
-
-=head2 IsExternalValues
-
-=cut
-
-sub IsExternalValues {
- my $self = shift;
- return 0 unless $self->IsSelectionType( @_ );
- return $self->ValuesClass eq 'RT::CustomFieldValues'? 0 : 1;
-}
-
-sub ValuesClass {
- my $self = shift;
- return $self->_Value( ValuesClass => @_ ) || 'RT::CustomFieldValues';
-}
-
-sub SetValuesClass {
- my $self = shift;
- my $class = shift || 'RT::CustomFieldValues';
-
- if ( $class eq 'RT::CustomFieldValues' ) {
- return $self->_Set( Field => 'ValuesClass', Value => undef, @_ );
- }
-
- return (0, $self->loc("This Custom Field can not have list of values"))
- unless $self->IsSelectionType;
-
- unless ( $self->ValidateValuesClass( $class ) ) {
- return (0, $self->loc("Invalid Custom Field values source"));
- }
- return $self->_Set( Field => 'ValuesClass', Value => $class, @_ );
-}
-
-sub ValidateValuesClass {
- my $self = shift;
- my $class = shift;
-
- return 1 if !$class || $class eq 'RT::CustomFieldValues';
- return 1 if grep $class eq $_, RT->Config->Get('CustomFieldValuesSources');
- return undef;
-}
-
-
-=head2 FriendlyType [TYPE, MAX_VALUES]
-
-Returns a localized human-readable version of the custom field type.
-If a custom field type is specified as the parameter, the friendly type for that type will be returned
-
-=cut
-
-sub FriendlyType {
- my $self = shift;
-
- my $type = @_ ? shift : $self->Type;
- my $max = @_ ? shift : $self->MaxValues;
- $max = 0 unless $max;
-
- if (my $friendly_type = $FieldTypes{$type}->{labels}->[$max>2 ? 2 : $max]) {
- return ( $self->loc( $friendly_type, $max ) );
- }
- else {
- return ( $self->loc( $type ) );
- }
-}
-
-sub FriendlyTypeComposite {
- my $self = shift;
- my $composite = shift || $self->TypeComposite;
- return $self->FriendlyType(split(/-/, $composite, 2));
-}
-
-
-=head2 ValidateType TYPE
-
-Takes a single string. returns true if that string is a value
-type of custom field
-
-
-=cut
-
-sub ValidateType {
- my $self = shift;
- my $type = shift;
-
- if ( $type =~ s/(?:Single|Multiple)$// ) {
- $RT::Logger->warning( "Prefix 'Single' and 'Multiple' to Type deprecated, use MaxValues instead at (". join(":",caller).")");
- }
-
- if ( $FieldTypes{$type} ) {
- return 1;
- }
- else {
- return undef;
- }
-}
-
-
-sub SetType {
- my $self = shift;
- my $type = shift;
- if ($type =~ s/(?:(Single)|Multiple)$//) {
- $RT::Logger->warning("'Single' and 'Multiple' on SetType deprecated, use SetMaxValues instead at (". join(":",caller).")");
- $self->SetMaxValues($1 ? 1 : 0);
- }
- $self->_Set(Field => 'Type', Value =>$type);
-}
-
-=head2 SetPattern STRING
-
-Takes a single string representing a regular expression. Performs basic
-validation on that regex, and sets the C<Pattern> field for the CF if it
-is valid.
-
-=cut
-
-sub SetPattern {
- my $self = shift;
- my $regex = shift;
-
- my ($ok, $msg) = $self->_IsValidRegex($regex);
- if ($ok) {
- return $self->_Set(Field => 'Pattern', Value => $regex);
- }
- else {
- return (0, $self->loc("Invalid pattern: [_1]", $msg));
- }
-}
-
-=head2 _IsValidRegex(Str $regex) returns (Bool $success, Str $msg)
-
-Tests if the string contains an invalid regex.
-
-=cut
-
-sub _IsValidRegex {
- my $self = shift;
- my $regex = shift or return (1, 'valid');
-
- local $^W; local $@;
- local $SIG{__DIE__} = sub { 1 };
- local $SIG{__WARN__} = sub { 1 };
-
- if (eval { qr/$regex/; 1 }) {
- return (1, 'valid');
- }
-
- my $err = $@;
- $err =~ s{[,;].*}{}; # strip debug info from error
- chomp $err;
- return (0, $err);
-}
-
-
-=head2 SingleValue
-
-Returns true if this CustomField only accepts a single value.
-Returns false if it accepts multiple values
-
-=cut
-
-sub SingleValue {
- my $self = shift;
- if (($self->MaxValues||0) == 1) {
- return 1;
- }
- else {
- return undef;
- }
-}
-
-sub UnlimitedValues {
- my $self = shift;
- if (($self->MaxValues||0) == 0) {
- return 1;
- }
- else {
- return undef;
- }
-}
-
-
-=head2 CurrentUserHasRight RIGHT
-
-Helper function to call the custom field's queue's CurrentUserHasRight with the passed in args.
-
-=cut
-
-sub CurrentUserHasRight {
- my $self = shift;
- my $right = shift;
-
- return $self->CurrentUser->HasRight(
- Object => $self,
- Right => $right,
- );
-}
-
-=head2 ACLEquivalenceObjects
-
-Returns list of objects via which users can get rights on this custom field. For custom fields
-these objects can be set using L<ContextObject|/"ContextObject and SetContextObject">.
-
-=cut
-
-sub ACLEquivalenceObjects {
- my $self = shift;
-
- my $ctx = $self->ContextObject
- or return;
- return ($ctx, $ctx->ACLEquivalenceObjects);
-}
-
-=head2 ContextObject and SetContextObject
-
-Set or get a context for this object. It can be ticket, queue or another object
-this CF applies to. Used for ACL control, for example SeeCustomField can be granted on
-queue level to allow people to see all fields applied to the queue.
-
-=cut
-
-sub SetContextObject {
- my $self = shift;
- return $self->{'context_object'} = shift;
-}
-
-sub ContextObject {
- my $self = shift;
- return $self->{'context_object'};
-}
-
-sub ValidContextType {
- my $self = shift;
- my $class = shift;
-
- my %valid;
- $valid{$_}++ for split '-', $self->LookupType;
- delete $valid{'RT::Transaction'};
-
- return $valid{$class};
-}
-
-=head2 LoadContextObject
-
-Takes an Id for a Context Object and loads the right kind of RT::Object
-for this particular Custom Field (based on the LookupType) and returns it.
-This is a good way to ensure you don't try to use a Queue as a Context
-Object on a User Custom Field.
-
-=cut
-
-sub LoadContextObject {
- my $self = shift;
- my $type = shift;
- my $contextid = shift;
-
- unless ( $self->ValidContextType($type) ) {
- RT->Logger->debug("Invalid ContextType $type for Custom Field ".$self->Id);
- return;
- }
-
- my $context_object = $type->new( $self->CurrentUser );
- my ($id, $msg) = $context_object->LoadById( $contextid );
- unless ( $id ) {
- RT->Logger->debug("Invalid ContextObject id: $msg");
- return;
- }
- return $context_object;
-}
-
-=head2 ValidateContextObject
-
-Ensure that a given ContextObject applies to this Custom Field.
-For custom fields that are assigned to Queues or to Classes, this checks that the Custom
-Field is actually applied to that objects. For Global Custom Fields, it returns true
-as long as the Object is of the right type, because you may be using
-your permissions on a given Queue of Class to see a Global CF.
-For CFs that are only applied Globally, you don't need a ContextObject.
-
-=cut
-
-sub ValidateContextObject {
- my $self = shift;
- my $object = shift;
-
- return 1 if $self->IsApplied(0);
-
- # global only custom fields don't have objects
- # that should be used as context objects.
- return if $self->ApplyGlobally;
-
- # Otherwise, make sure we weren't passed a user object that we're
- # supposed to treat as a queue.
- return unless $self->ValidContextType(ref $object);
-
- # Check that it is applied correctly
- my ($applied_to) = grep {ref($_) eq $self->RecordClassFromLookupType} ($object, $object->ACLEquivalenceObjects);
- return unless $applied_to;
- return $self->IsApplied($applied_to->id);
-}
-
-
-sub _Set {
- my $self = shift;
-
- unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- return $self->SUPER::_Set( @_ );
-
-}
-
-
-
-=head2 _Value
-
-Takes the name of a table column.
-Returns its value as a string, if the user passes an ACL check
-
-=cut
-
-sub _Value {
- my $self = shift;
- return undef unless $self->id;
-
- # we need to do the rights check
- unless ( $self->CurrentUserHasRight('SeeCustomField') ) {
- $RT::Logger->debug(
- "Permission denied. User #". $self->CurrentUser->id
- ." has no SeeCustomField right on CF #". $self->id
- );
- return (undef);
- }
- return $self->__Value( @_ );
-}
-
-
-=head2 SetDisabled
-
-Takes a boolean.
-1 will cause this custom field to no longer be avaialble for objects.
-0 will re-enable this field.
-
-=cut
-
-
-=head2 SetTypeComposite
-
-Set this custom field's type and maximum values as a composite value
-
-=cut
-
-sub SetTypeComposite {
- my $self = shift;
- my $composite = shift;
-
- my $old = $self->TypeComposite;
-
- my ($type, $max_values) = split(/-/, $composite, 2);
- if ( $type ne $self->Type ) {
- my ($status, $msg) = $self->SetType( $type );
- return ($status, $msg) unless $status;
- }
- if ( ($max_values || 0) != ($self->MaxValues || 0) ) {
- my ($status, $msg) = $self->SetMaxValues( $max_values );
- return ($status, $msg) unless $status;
- }
- my $render = $self->RenderType;
- if ( $render and not grep { $_ eq $render } $self->RenderTypes ) {
- # We switched types and our render type is no longer valid, so unset it
- # and use the default
- $self->SetRenderType( undef );
- }
- return 1, $self->loc(
- "Type changed from '[_1]' to '[_2]'",
- $self->FriendlyTypeComposite( $old ),
- $self->FriendlyTypeComposite( $composite ),
- );
-}
-
-=head2 TypeComposite
-
-Returns a composite value composed of this object's type and maximum values
-
-=cut
-
-
-sub TypeComposite {
- my $self = shift;
- return join '-', ($self->Type || ''), ($self->MaxValues || 0);
-}
-
-=head2 TypeComposites
-
-Returns an array of all possible composite values for custom fields.
-
-=cut
-
-sub TypeComposites {
- my $self = shift;
- return grep !/(?:[Tt]ext|Combobox|Date|DateTime|TimeValue)-0/, map { ("$_-1", "$_-0") } $self->Types;
-}
-
-=head2 RenderType
-
-Returns the type of form widget to render for this custom field. Currently
-this only affects fields which return true for L</HasRenderTypes>.
-
-=cut
-
-sub RenderType {
- my $self = shift;
- return '' unless $self->HasRenderTypes;
-
- return $self->_Value( 'RenderType', @_ )
- || $self->DefaultRenderType;
-}
-
-=head2 SetRenderType TYPE
-
-Sets this custom field's render type.
-
-=cut
-
-sub SetRenderType {
- my $self = shift;
- my $type = shift;
- return (0, $self->loc("This custom field has no Render Types"))
- unless $self->HasRenderTypes;
-
- if ( !$type || $type eq $self->DefaultRenderType ) {
- return $self->_Set( Field => 'RenderType', Value => undef, @_ );
- }
-
- if ( not grep { $_ eq $type } $self->RenderTypes ) {
- return (0, $self->loc("Invalid Render Type for custom field of type [_1]",
- $self->FriendlyType));
- }
-
- return $self->_Set( Field => 'RenderType', Value => $type, @_ );
-}
-
-=head2 DefaultRenderType [TYPE COMPOSITE]
-
-Returns the default render type for this custom field's type or the TYPE
-COMPOSITE specified as an argument.
-
-=cut
-
-sub DefaultRenderType {
- my $self = shift;
- my $composite = @_ ? shift : $self->TypeComposite;
- my ($type, $max) = split /-/, $composite, 2;
- return unless $type and $self->HasRenderTypes($composite);
- return $FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }[0];
-}
-
-=head2 HasRenderTypes [TYPE_COMPOSITE]
-
-Returns a boolean value indicating whether the L</RenderTypes> and
-L</RenderType> methods make sense for this custom field.
-
-Currently true only for type C<Select>.
-
-=cut
-
-sub HasRenderTypes {
- my $self = shift;
- my ($type, $max) = split /-/, (@_ ? shift : $self->TypeComposite), 2;
- return undef unless $type;
- return defined $FieldTypes{$type}->{render_types}
- ->{ $max == 1 ? 'single' : 'multiple' };
-}
-
-=head2 RenderTypes [TYPE COMPOSITE]
-
-Returns the valid render types for this custom field's type or the TYPE
-COMPOSITE specified as an argument.
-
-=cut
-
-sub RenderTypes {
- my $self = shift;
- my $composite = @_ ? shift : $self->TypeComposite;
- my ($type, $max) = split /-/, $composite, 2;
- return unless $type and $self->HasRenderTypes($composite);
- return @{$FieldTypes{$type}->{render_types}->{ $max == 1 ? 'single' : 'multiple' }};
-}
-
-=head2 SetLookupType
-
-Autrijus: care to doc how LookupTypes work?
-
-=cut
-
-sub SetLookupType {
- my $self = shift;
- my $lookup = shift;
- if ( $lookup ne $self->LookupType ) {
- # Okay... We need to invalidate our existing relationships
- my $ObjectCustomFields = RT::ObjectCustomFields->new($self->CurrentUser);
- $ObjectCustomFields->LimitToCustomField($self->Id);
- $_->Delete foreach @{$ObjectCustomFields->ItemsArrayRef};
- }
- return $self->_Set(Field => 'LookupType', Value =>$lookup);
-}
-
-=head2 LookupTypes
-
-Returns an array of LookupTypes available
-
-=cut
-
-
-sub LookupTypes {
- my $self = shift;
- return sort keys %FRIENDLY_OBJECT_TYPES;
-}
-
-my @FriendlyObjectTypes = (
- "[_1] objects", # loc
- "[_1]'s [_2] objects", # loc
- "[_1]'s [_2]'s [_3] objects", # loc
-);
-
-=head2 FriendlyLookupType
-
-Returns a localized description of the type of this custom field
-
-=cut
-
-sub FriendlyLookupType {
- my $self = shift;
- my $lookup = shift || $self->LookupType;
-
- return ($self->loc( $FRIENDLY_OBJECT_TYPES{$lookup} ))
- if (defined $FRIENDLY_OBJECT_TYPES{$lookup} );
-
- my @types = map { s/^RT::// ? $self->loc($_) : $_ }
- grep { defined and length }
- split( /-/, $lookup )
- or return;
- return ( $self->loc( $FriendlyObjectTypes[$#types], @types ) );
-}
-
-=head1 RecordClassFromLookupType
-
-Returns the type of Object referred to by ObjectCustomFields' ObjectId column
-
-Optionally takes a LookupType to use instead of using the value on the loaded
-record. In this case, the method may be called on the class instead of an
-object.
-
-=cut
-
-sub RecordClassFromLookupType {
- my $self = shift;
- my $type = shift || $self->LookupType;
- my ($class) = ($type =~ /^([^-]+)/);
- unless ( $class ) {
- if (blessed($self) and $self->LookupType eq $type) {
- $RT::Logger->error(
- "Custom Field #". $self->id
- ." has incorrect LookupType '$type'"
- );
- } else {
- RT->Logger->error("Invalid LookupType passed as argument: $type");
- }
- return undef;
- }
- return $class;
-}
-
-=head1 ObjectTypeFromLookupType
-
-Returns the ObjectType used in ObjectCustomFieldValues rows for this CF
-
-Optionally takes a LookupType to use instead of using the value on the loaded
-record. In this case, the method may be called on the class instead of an
-object.
-
-=cut
-
-sub ObjectTypeFromLookupType {
- my $self = shift;
- my $type = shift || $self->LookupType;
- my ($class) = ($type =~ /([^-]+)$/);
- unless ( $class ) {
- if (blessed($self) and $self->LookupType eq $type) {
- $RT::Logger->error(
- "Custom Field #". $self->id
- ." has incorrect LookupType '$type'"
- );
- } else {
- RT->Logger->error("Invalid LookupType passed as argument: $type");
- }
- return undef;
- }
- return $class;
-}
-
-sub CollectionClassFromLookupType {
- my $self = shift;
-
- my $record_class = $self->RecordClassFromLookupType;
- return undef unless $record_class;
-
- my $collection_class;
- if ( UNIVERSAL::can($record_class.'Collection', 'new') ) {
- $collection_class = $record_class.'Collection';
- } elsif ( UNIVERSAL::can($record_class.'es', 'new') ) {
- $collection_class = $record_class.'es';
- } elsif ( UNIVERSAL::can($record_class.'s', 'new') ) {
- $collection_class = $record_class.'s';
- } else {
- $RT::Logger->error("Can not find a collection class for record class '$record_class'");
- return undef;
- }
- return $collection_class;
-}
-
-=head1 ApplyGlobally
-
-Certain custom fields (users, groups) should only be applied globally
-but rather than regexing in code for LookupType =~ RT::Queue, we'll codify
-the rules here.
-
-=cut
-
-sub ApplyGlobally {
- my $self = shift;
-
- return ($self->LookupType =~ /^RT::(?:Group|User)/io);
-
-}
-
-=head1 AppliedTo
-
-Returns collection with objects this custom field is applied to.
-Class of the collection depends on L</LookupType>.
-See all L</NotAppliedTo> .
-
-Doesn't takes into account if object is applied globally.
-
-=cut
-
-sub AppliedTo {
- my $self = shift;
-
- my ($res, $ocfs_alias) = $self->_AppliedTo;
- return $res unless $res;
-
- $res->Limit(
- ALIAS => $ocfs_alias,
- FIELD => 'id',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- );
-
- return $res;
-}
-
-=head1 NotAppliedTo
-
-Returns collection with objects this custom field is not applied to.
-Class of the collection depends on L</LookupType>.
-See all L</AppliedTo> .
-
-Doesn't takes into account if object is applied globally.
-
-=cut
-
-sub NotAppliedTo {
- my $self = shift;
-
- my ($res, $ocfs_alias) = $self->_AppliedTo;
- return $res unless $res;
-
- $res->Limit(
- ALIAS => $ocfs_alias,
- FIELD => 'id',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- );
-
- return $res;
-}
-
-sub _AppliedTo {
- my $self = shift;
-
- my ($class) = $self->CollectionClassFromLookupType;
- return undef unless $class;
-
- my $res = $class->new( $self->CurrentUser );
-
- # If CF is a Group CF, only display user-defined groups
- if ( $class eq 'RT::Groups' ) {
- $res->LimitToUserDefinedGroups;
- }
-
- $res->OrderBy( FIELD => 'Name' );
- my $ocfs_alias = $res->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'ObjectCustomFields',
- FIELD2 => 'ObjectId',
- );
- $res->Limit(
- LEFTJOIN => $ocfs_alias,
- ALIAS => $ocfs_alias,
- FIELD => 'CustomField',
- VALUE => $self->id,
- );
- return ($res, $ocfs_alias);
-}
-
-=head2 IsApplied
-
-Takes object id and returns corresponding L<RT::ObjectCustomField>
-record if this custom field is applied to the object. Use 0 to check
-if custom field is applied globally.
-
-=cut
-
-sub IsApplied {
- my $self = shift;
- my $id = shift;
- my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
- $ocf->LoadByCols( CustomField => $self->id, ObjectId => $id || 0 );
- return undef unless $ocf->id;
- return $ocf;
-}
-
-=head2 AddToObject OBJECT
-
-Add this custom field as a custom field for a single object, such as a queue or group.
-
-Takes an object
-
-=cut
-
-
-sub AddToObject {
- my $self = shift;
- my $object = shift;
- my $id = $object->Id || 0;
-
- unless (index($self->LookupType, ref($object)) == 0) {
- return ( 0, $self->loc('Lookup type mismatch') );
- }
-
- unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
-
- if ( $self->IsApplied( $id ) ) {
- return ( 0, $self->loc("Custom field is already applied to the object") );
- }
-
- if ( $id ) {
- # applying locally
- return (0, $self->loc("Couldn't apply custom field to an object as it's global already") )
- if $self->IsApplied( 0 );
- }
- else {
- my $applied = RT::ObjectCustomFields->new( $self->CurrentUser );
- $applied->LimitToCustomField( $self->id );
- while ( my $record = $applied->Next ) {
- $record->Delete;
- }
- }
-
- my $ocf = RT::ObjectCustomField->new( $self->CurrentUser );
- my ( $oid, $msg ) = $ocf->Create(
- ObjectId => $id, CustomField => $self->id,
- );
- return ( $oid, $msg );
-}
-
-
-=head2 RemoveFromObject OBJECT
-
-Remove this custom field for a single object, such as a queue or group.
-
-Takes an object
-
-=cut
-
-sub RemoveFromObject {
- my $self = shift;
- my $object = shift;
- my $id = $object->Id || 0;
-
- unless (index($self->LookupType, ref($object)) == 0) {
- return ( 0, $self->loc('Object type mismatch') );
- }
-
- unless ( $object->CurrentUserHasRight('AssignCustomFields') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
-
- my $ocf = $self->IsApplied( $id );
- unless ( $ocf ) {
- return ( 0, $self->loc("This custom field does not apply to that object") );
- }
-
- # XXX: Delete doesn't return anything
- my ( $oid, $msg ) = $ocf->Delete;
- return ( $oid, $msg );
-}
-
-
-=head2 AddValueForObject HASH
-
-Adds a custom field value for a record object of some kind.
-Takes a param hash of
-
-Required:
-
- Object
- Content
-
-Optional:
-
- LargeContent
- ContentType
-
-=cut
-
-sub AddValueForObject {
- my $self = shift;
- my %args = (
- Object => undef,
- Content => undef,
- LargeContent => undef,
- ContentType => undef,
- @_
- );
- my $obj = $args{'Object'} or return ( 0, $self->loc('Invalid object') );
-
- unless ( $self->CurrentUserHasRight('ModifyCustomField') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
-
- unless ( $self->MatchPattern($args{'Content'}) ) {
- return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
- }
-
- $RT::Handle->BeginTransaction;
-
- if ( $self->MaxValues ) {
- my $current_values = $self->ValuesForObject($obj);
- my $extra_values = ( $current_values->Count + 1 ) - $self->MaxValues;
-
- # (The +1 is for the new value we're adding)
-
- # If we have a set of current values and we've gone over the maximum
- # allowed number of values, we'll need to delete some to make room.
- # which former values are blown away is not guaranteed
-
- while ($extra_values) {
- my $extra_item = $current_values->Next;
- unless ( $extra_item->id ) {
- $RT::Logger->crit( "We were just asked to delete "
- ."a custom field value that doesn't exist!" );
- $RT::Handle->Rollback();
- return (undef);
- }
- $extra_item->Delete;
- $extra_values--;
- }
- }
-
- if (my $canonicalizer = $self->can('_CanonicalizeValue'.$self->Type)) {
- $canonicalizer->($self, \%args);
- }
-
-
-
- my $newval = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
- my ($val, $msg) = $newval->Create(
- ObjectType => ref($obj),
- ObjectId => $obj->Id,
- Content => $args{'Content'},
- LargeContent => $args{'LargeContent'},
- ContentType => $args{'ContentType'},
- CustomField => $self->Id
- );
-
- unless ($val) {
- $RT::Handle->Rollback();
- return ($val, $self->loc("Couldn't create record: [_1]", $msg));
- }
-
- $RT::Handle->Commit();
- return ($val);
-
-}
-
-
-
-sub _CanonicalizeValueDateTime {
- my $self = shift;
- my $args = shift;
- my $DateObj = RT::Date->new( $self->CurrentUser );
- $DateObj->Set( Format => 'unknown',
- Value => $args->{'Content'} );
- $args->{'Content'} = $DateObj->ISO;
-}
-
-# For date, we need to store Content as ISO date
-sub _CanonicalizeValueDate {
- my $self = shift;
- my $args = shift;
-
- # in case user input date with time, let's omit it by setting timezone
- # to utc so "hour" won't affect "day"
- my $DateObj = RT::Date->new( $self->CurrentUser );
- $DateObj->Set( Format => 'unknown',
- Value => $args->{'Content'},
- );
- $args->{'Content'} = $DateObj->Date( Timezone => 'user' );
-}
-
-=head2 MatchPattern STRING
-
-Tests the incoming string against the Pattern of this custom field object
-and returns a boolean; returns true if the Pattern is empty.
-
-=cut
-
-sub MatchPattern {
- my $self = shift;
- my $regex = $self->Pattern or return 1;
-
- return (( defined $_[0] ? $_[0] : '') =~ $regex);
-}
-
-
-
-
-=head2 FriendlyPattern
-
-Prettify the pattern of this custom field, by taking the text in C<(?#text)>
-and localizing it.
-
-=cut
-
-sub FriendlyPattern {
- my $self = shift;
- my $regex = $self->Pattern;
-
- return '' unless length $regex;
- if ( $regex =~ /\(\?#([^)]*)\)/ ) {
- return '[' . $self->loc($1) . ']';
- }
- else {
- return $regex;
- }
-}
-
-
-
-
-=head2 DeleteValueForObject HASH
-
-Deletes a custom field value for a ticket. Takes a param hash of Object and Content
-
-Returns a tuple of (STATUS, MESSAGE). If the call succeeded, the STATUS is true. otherwise it's false
-
-=cut
-
-sub DeleteValueForObject {
- my $self = shift;
- my %args = ( Object => undef,
- Content => undef,
- Id => undef,
- @_ );
-
-
- unless ($self->CurrentUserHasRight('ModifyCustomField')) {
- return (0, $self->loc('Permission Denied'));
- }
-
- my $oldval = RT::ObjectCustomFieldValue->new($self->CurrentUser);
-
- if (my $id = $args{'Id'}) {
- $oldval->Load($id);
- }
- unless ($oldval->id) {
- $oldval->LoadByObjectContentAndCustomField(
- Object => $args{'Object'},
- Content => $args{'Content'},
- CustomField => $self->Id,
- );
- }
-
-
- # check to make sure we found it
- unless ($oldval->Id) {
- return(0, $self->loc("Custom field value [_1] could not be found for custom field [_2]", $args{'Content'}, $self->Name));
- }
-
- # for single-value fields, we need to validate that empty string is a valid value for it
- if ( $self->SingleValue and not $self->MatchPattern( '' ) ) {
- return ( 0, $self->loc('Input must match [_1]', $self->FriendlyPattern) );
- }
-
- # delete it
-
- my $ret = $oldval->Delete();
- unless ($ret) {
- return(0, $self->loc("Custom field value could not be found"));
- }
- return($oldval->Id, $self->loc("Custom field value deleted"));
-}
-
-
-=head2 ValuesForObject OBJECT
-
-Return an L<RT::ObjectCustomFieldValues> object containing all of this custom field's values for OBJECT
-
-=cut
-
-sub ValuesForObject {
- my $self = shift;
- my $object = shift;
-
- my $values = RT::ObjectCustomFieldValues->new($self->CurrentUser);
- unless ($self->id and $self->CurrentUserHasRight('SeeCustomField')) {
- # Return an empty object if they have no rights to see
- $values->Limit( FIELD => "id", VALUE => 0, SUBCLAUSE => "ACL" );
- return ($values);
- }
-
- $values->LimitToCustomField($self->Id);
- $values->LimitToObject($object);
-
- return ($values);
-}
-
-
-=head2 _ForObjectType PATH FRIENDLYNAME
-
-Tell RT that a certain object accepts custom fields
-
-Examples:
-
- 'RT::Queue-RT::Ticket' => "Tickets", # loc
- 'RT::Queue-RT::Ticket-RT::Transaction' => "Ticket Transactions", # loc
- 'RT::User' => "Users", # loc
- 'RT::Group' => "Groups", # loc
- 'RT::Queue' => "Queues", # loc
-
-This is a class method.
-
-=cut
-
-sub _ForObjectType {
- my $self = shift;
- my $path = shift;
- my $friendly_name = shift;
-
- $FRIENDLY_OBJECT_TYPES{$path} = $friendly_name;
-
-}
-
-
-=head2 IncludeContentForValue [VALUE] (and SetIncludeContentForValue)
-
-Gets or sets the C<IncludeContentForValue> for this custom field. RT
-uses this field to automatically include content into the user's browser
-as they display records with custom fields in RT.
-
-=cut
-
-sub SetIncludeContentForValue {
- shift->IncludeContentForValue(@_);
-}
-sub IncludeContentForValue{
- my $self = shift;
- $self->_URLTemplate('IncludeContentForValue', @_);
-}
-
-
-
-=head2 LinkValueTo [VALUE] (and SetLinkValueTo)
-
-Gets or sets the C<LinkValueTo> for this custom field. RT
-uses this field to make custom field values into hyperlinks in the user's
-browser as they display records with custom fields in RT.
-
-=cut
-
-
-sub SetLinkValueTo {
- shift->LinkValueTo(@_);
-}
-
-sub LinkValueTo {
- my $self = shift;
- $self->_URLTemplate('LinkValueTo', @_);
-
-}
-
-
-=head2 _URLTemplate NAME [VALUE]
-
-With one argument, returns the _URLTemplate named C<NAME>, but only if
-the current user has the right to see this custom field.
-
-With two arguments, attemptes to set the relevant template value.
-
-=cut
-
-sub _URLTemplate {
- my $self = shift;
- my $template_name = shift;
- if (@_) {
-
- my $value = shift;
- unless ( $self->CurrentUserHasRight('AdminCustomField') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- $self->SetAttribute( Name => $template_name, Content => $value );
- return ( 1, $self->loc('Updated') );
- } else {
- unless ( $self->id && $self->CurrentUserHasRight('SeeCustomField') ) {
- return (undef);
- }
-
- my @attr = $self->Attributes->Named($template_name);
- my $attr = shift @attr;
-
- if ($attr) { return $attr->Content }
-
- }
-}
-
-sub SetBasedOn {
- my $self = shift;
- my $value = shift;
-
- return $self->_Set( Field => 'BasedOn', Value => $value, @_ )
- unless defined $value and length $value;
-
- my $cf = RT::CustomField->new( $self->CurrentUser );
- $cf->SetContextObject( $self->ContextObject );
- $cf->Load( ref $value ? $value->id : $value );
-
- return (0, "Permission denied")
- unless $cf->id && $cf->CurrentUserHasRight('SeeCustomField');
-
- # XXX: Remove this restriction once we support lists and cascaded selects
- if ( $self->RenderType =~ /List/ ) {
- return (0, $self->loc("We can't currently render as a List when basing categories on another custom field. Please use another render type."));
- }
-
- return $self->_Set( Field => 'BasedOn', Value => $value, @_ )
-}
-
-sub BasedOnObj {
- my $self = shift;
-
- my $obj = RT::CustomField->new( $self->CurrentUser );
- $obj->SetContextObject( $self->ContextObject );
- if ( $self->BasedOn ) {
- $obj->Load( $self->BasedOn );
- }
- return $obj;
-}
-
-sub UILocation {
- my $self = shift;
- my $tag = $self->FirstAttribute( 'UILocation' );
- return $tag ? $tag->Content : '';
-}
-
-sub SetUILocation {
- my $self = shift;
- my $tag = shift;
- if ( $tag ) {
- return $self->SetAttribute( Name => 'UILocation', Content => $tag );
- }
- else {
- return $self->DeleteAttribute('UILocation');
- }
-}
-
-sub NoClone {
- my $self = shift;
- $self->FirstAttribute('NoClone') ? 1 : '';
-}
-
-sub SetNoClone {
- my $self = shift;
- my $value = shift;
- if ( $value ) {
- return $self->SetAttribute( Name => 'NoClone', Content => 1 );
- } else {
- return $self->DeleteAttribute('NoClone');
- }
-}
-
-
-=head2 id
-
-Returns the current value of id.
-(In the database, id is stored as int(11).)
-
-
-=cut
-
-
-=head2 Name
-
-Returns the current value of Name.
-(In the database, Name is stored as varchar(200).)
-
-
-
-=head2 SetName VALUE
-
-
-Set Name to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Name will be stored as a varchar(200).)
-
-
-=cut
-
-
-=head2 Type
-
-Returns the current value of Type.
-(In the database, Type is stored as varchar(200).)
-
-
-
-=head2 SetType VALUE
-
-
-Set Type to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Type will be stored as a varchar(200).)
-
-
-=cut
-
-
-=head2 RenderType
-
-Returns the current value of RenderType.
-(In the database, RenderType is stored as varchar(64).)
-
-
-
-=head2 SetRenderType VALUE
-
-
-Set RenderType to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, RenderType will be stored as a varchar(64).)
-
-
-=cut
-
-
-=head2 MaxValues
-
-Returns the current value of MaxValues.
-(In the database, MaxValues is stored as int(11).)
-
-
-
-=head2 SetMaxValues VALUE
-
-
-Set MaxValues to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, MaxValues will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Pattern
-
-Returns the current value of Pattern.
-(In the database, Pattern is stored as text.)
-
-
-
-=head2 SetPattern VALUE
-
-
-Set Pattern to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Pattern will be stored as a text.)
-
-
-=cut
-
-
-=head2 Repeated
-
-Returns the current value of Repeated.
-(In the database, Repeated is stored as smallint(6).)
-
-
-
-=head2 SetRepeated VALUE
-
-
-Set Repeated to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Repeated will be stored as a smallint(6).)
-
-
-=cut
-
-
-=head2 BasedOn
-
-Returns the current value of BasedOn.
-(In the database, BasedOn is stored as int(11).)
-
-
-
-=head2 SetBasedOn VALUE
-
-
-Set BasedOn to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, BasedOn will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Description
-
-Returns the current value of Description.
-(In the database, Description is stored as varchar(255).)
-
-
-
-=head2 SetDescription VALUE
-
-
-Set Description to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Description will be stored as a varchar(255).)
-
-
-=cut
-
-
-=head2 SortOrder
-
-Returns the current value of SortOrder.
-(In the database, SortOrder is stored as int(11).)
-
-
-
-=head2 SetSortOrder VALUE
-
-
-Set SortOrder to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, SortOrder will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 LookupType
-
-Returns the current value of LookupType.
-(In the database, LookupType is stored as varchar(255).)
-
-
-
-=head2 SetLookupType VALUE
-
-
-Set LookupType to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, LookupType will be stored as a varchar(255).)
-
-
-=cut
-
-
-=head2 Creator
-
-Returns the current value of Creator.
-(In the database, Creator is stored as int(11).)
-
-
-=cut
-
-
-=head2 Created
-
-Returns the current value of Created.
-(In the database, Created is stored as datetime.)
-
-
-=cut
-
-
-=head2 LastUpdatedBy
-
-Returns the current value of LastUpdatedBy.
-(In the database, LastUpdatedBy is stored as int(11).)
-
-
-=cut
-
-
-=head2 LastUpdated
-
-Returns the current value of LastUpdated.
-(In the database, LastUpdated is stored as datetime.)
-
-
-=cut
-
-
-=head2 Disabled
-
-Returns the current value of Disabled.
-(In the database, Disabled is stored as smallint(6).)
-
-
-
-=head2 SetDisabled VALUE
-
-
-Set Disabled to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Disabled will be stored as a smallint(6).)
-
-
-=cut
-
-
-
-sub _CoreAccessible {
- {
-
- id =>
- {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
- Name =>
- {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''},
- Type =>
- {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => ''},
- RenderType =>
- {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''},
- MaxValues =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
- Pattern =>
- {read => 1, write => 1, sql_type => -4, length => 0, is_blob => 1, is_numeric => 0, type => 'text', default => ''},
- Repeated =>
- {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'},
- ValuesClass =>
- {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''},
- BasedOn =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
- Description =>
- {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
- SortOrder =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- LookupType =>
- {read => 1, write => 1, sql_type => 12, length => 255, is_blob => 0, is_numeric => 0, type => 'varchar(255)', default => ''},
- Creator =>
- {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Created =>
- {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- LastUpdatedBy =>
- {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- LastUpdated =>
- {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Disabled =>
- {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'},
-
- }
-};
-
-
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-package RT::EmailParser;
-
-
-use base qw/RT::Base/;
-
-use strict;
-use warnings;
-
-
-use Email::Address;
-use MIME::Entity;
-use MIME::Head;
-use MIME::Parser;
-use File::Temp qw/tempdir/;
-
-=head1 NAME
-
- RT::EmailParser - helper functions for parsing parts from incoming
- email messages
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-
-
-
-=head1 METHODS
-
-=head2 new
-
-Returns a new RT::EmailParser object
-
-=cut
-
-sub new {
- my $proto = shift;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
- return $self;
-}
-
-
-=head2 SmartParseMIMEEntityFromScalar Message => SCALAR_REF [, Decode => BOOL, Exact => BOOL ] }
-
-Parse a message stored in a scalar from scalar_ref.
-
-=cut
-
-sub SmartParseMIMEEntityFromScalar {
- my $self = shift;
- my %args = ( Message => undef, Decode => 1, Exact => 0, @_ );
-
- eval {
- my ( $fh, $temp_file );
- for ( 1 .. 10 ) {
-
- # on NFS and NTFS, it is possible that tempfile() conflicts
- # with other processes, causing a race condition. we try to
- # accommodate this by pausing and retrying.
- last
- if ( $fh, $temp_file ) =
- eval { File::Temp::tempfile( UNLINK => 0 ) };
- sleep 1;
- }
- if ($fh) {
-
- #thank you, windows
- binmode $fh;
- $fh->autoflush(1);
- print $fh $args{'Message'};
- close($fh);
- if ( -f $temp_file ) {
-
- # We have to trust the temp file's name -- untaint it
- $temp_file =~ /(.*)/;
- my $entity = $self->ParseMIMEEntityFromFile( $1, $args{'Decode'}, $args{'Exact'} );
- unlink($1);
- return $entity;
- }
- }
- };
-
- #If for some reason we weren't able to parse the message using a temp file
- # try it with a scalar
- if ( $@ || !$self->Entity ) {
- return $self->ParseMIMEEntityFromScalar( $args{'Message'}, $args{'Decode'}, $args{'Exact'} );
- }
-
-}
-
-
-=head2 ParseMIMEEntityFromSTDIN
-
-Parse a message from standard input
-
-=cut
-
-sub ParseMIMEEntityFromSTDIN {
- my $self = shift;
- return $self->ParseMIMEEntityFromFileHandle(\*STDIN, @_);
-}
-
-=head2 ParseMIMEEntityFromScalar $message
-
-Takes either a scalar or a reference to a scalar which contains a stringified MIME message.
-Parses it.
-
-Returns true if it wins.
-Returns false if it loses.
-
-=cut
-
-sub ParseMIMEEntityFromScalar {
- my $self = shift;
- return $self->_ParseMIMEEntity( shift, 'parse_data', @_ );
-}
-
-=head2 ParseMIMEEntityFromFilehandle *FH
-
-Parses a mime entity from a filehandle passed in as an argument
-
-=cut
-
-sub ParseMIMEEntityFromFileHandle {
- my $self = shift;
- return $self->_ParseMIMEEntity( shift, 'parse', @_ );
-}
-
-=head2 ParseMIMEEntityFromFile
-
-Parses a mime entity from a filename passed in as an argument
-
-=cut
-
-sub ParseMIMEEntityFromFile {
- my $self = shift;
- return $self->_ParseMIMEEntity( shift, 'parse_open', @_ );
-}
-
-
-sub _ParseMIMEEntity {
- my $self = shift;
- my $message = shift;
- my $method = shift;
- my $postprocess = (@_ ? shift : 1);
- my $exact = shift;
-
- # Create a new parser object:
- my $parser = MIME::Parser->new();
- $self->_SetupMIMEParser($parser);
- $parser->decode_bodies(0) if $exact;
-
- # TODO: XXX 3.0 we really need to wrap this in an eval { }
- unless ( $self->{'entity'} = $parser->$method($message) ) {
- $RT::Logger->crit("Couldn't parse MIME stream and extract the submessages");
- # Try again, this time without extracting nested messages
- $parser->extract_nested_messages(0);
- unless ( $self->{'entity'} = $parser->$method($message) ) {
- $RT::Logger->crit("couldn't parse MIME stream");
- return ( undef);
- }
- }
-
- $self->_PostProcessNewEntity if $postprocess;
-
- return $self->{'entity'};
-}
-
-sub _DecodeBodies {
- my $self = shift;
- return unless $self->{'entity'};
-
- my @parts = $self->{'entity'}->parts_DFS;
- $self->_DecodeBody($_) foreach @parts;
-}
-
-sub _DecodeBody {
- my $self = shift;
- my $entity = shift;
-
- my $old = $entity->bodyhandle or return;
- return unless $old->is_encoded;
-
- require MIME::Decoder;
- my $encoding = $entity->head->mime_encoding;
- my $decoder = MIME::Decoder->new($encoding);
- unless ( $decoder ) {
- $RT::Logger->error("Couldn't find decoder for '$encoding', switching to binary");
- $old->is_encoded(0);
- return;
- }
-
- require MIME::Body;
- # XXX: use InCore for now, but later must switch to files
- my $new = MIME::Body::InCore->new();
- $new->binmode(1);
- $new->is_encoded(0);
-
- my $source = $old->open('r') or die "couldn't open body: $!";
- my $destination = $new->open('w') or die "couldn't open body: $!";
- {
- local $@;
- eval { $decoder->decode($source, $destination) };
- $RT::Logger->error($@) if $@;
- }
- $source->close or die "can't close: $!";
- $destination->close or die "can't close: $!";
-
- $entity->bodyhandle( $new );
-}
-
-=head2 _PostProcessNewEntity
-
-cleans up and postprocesses a newly parsed MIME Entity
-
-=cut
-
-sub _PostProcessNewEntity {
- my $self = shift;
-
- #Now we've got a parsed mime object.
-
- # Unfold headers that are have embedded newlines
- # Better do this before conversion or it will break
- # with multiline encoded Subject (RFC2047) (fsck.com #5594)
- $self->Head->unfold;
-
- # try to convert text parts into utf-8 charset
- RT::I18N::SetMIMEEntityToEncoding($self->{'entity'}, 'utf-8');
-}
-
-=head2 ParseCcAddressesFromHead HASHREF
-
-Takes a hashref object containing QueueObj, Head and CurrentUser objects.
-Returns a list of all email addresses in the To and Cc
-headers b<except> the current Queue's email addresses, the CurrentUser's
-email address and anything that the RT->Config->Get('RTAddressRegexp') matches.
-
-=cut
-
-sub ParseCcAddressesFromHead {
- my $self = shift;
- my %args = (
- QueueObj => undef,
- CurrentUser => undef,
- @_
- );
-
- my (@Addresses);
-
- my @ToObjs = Email::Address->parse( $self->Head->get('To') );
- my @CcObjs = Email::Address->parse( $self->Head->get('Cc') );
-
- foreach my $AddrObj ( @ToObjs, @CcObjs ) {
- my $Address = $AddrObj->address;
- my $user = RT::User->new(RT->SystemUser);
- $Address = $user->CanonicalizeEmailAddress($Address);
- next if lc $args{'CurrentUser'}->EmailAddress eq lc $Address;
- next if $self->IsRTAddress($Address);
-
- push ( @Addresses, $Address );
- }
- return (@Addresses);
-}
-
-
-=head2 IsRTaddress ADDRESS
-
-Takes a single parameter, an email address.
-Returns true if that address matches the C<RTAddressRegexp> config option.
-Returns false, otherwise.
-
-
-=cut
-
-sub IsRTAddress {
- my $self = shift;
- my $address = shift;
-
- if ( my $address_re = RT->Config->Get('RTAddressRegexp') ) {
- return $address =~ /$address_re/i ? 1 : undef;
- }
-
- # we don't warn here, but do in config check
- if ( my $correspond_address = RT->Config->Get('CorrespondAddress') ) {
- return 1 if lc $correspond_address eq lc $address;
- }
- if ( my $comment_address = RT->Config->Get('CommentAddress') ) {
- return 1 if lc $comment_address eq lc $address;
- }
-
- my $queue = RT::Queue->new( RT->SystemUser );
- $queue->LoadByCols( CorrespondAddress => $address );
- return 1 if $queue->id;
-
- $queue->LoadByCols( CommentAddress => $address );
- return 1 if $queue->id;
-
- return undef;
-}
-
-
-=head2 CullRTAddresses ARRAY
-
-Takes a single argument, an array of email addresses.
-Returns the same array with any IsRTAddress()es weeded out.
-
-
-=cut
-
-sub CullRTAddresses {
- my $self = shift;
- my @addresses = (@_);
-
- return grep { !$self->IsRTAddress($_) } @addresses;
-}
-
-
-
-
-
-# LookupExternalUserInfo is a site-definable method for synchronizing
-# incoming users with an external data source.
-#
-# This routine takes a tuple of EmailAddress and FriendlyName
-# EmailAddress is the user's email address, ususally taken from
-# an email message's From: header.
-# FriendlyName is a freeform string, ususally taken from the "comment"
-# portion of an email message's From: header.
-#
-# If you define an AutoRejectRequest template, RT will use this
-# template for the rejection message.
-
-
-=head2 LookupExternalUserInfo
-
- LookupExternalUserInfo is a site-definable method for synchronizing
- incoming users with an external data source.
-
- This routine takes a tuple of EmailAddress and FriendlyName
- EmailAddress is the user's email address, ususally taken from
- an email message's From: header.
- FriendlyName is a freeform string, ususally taken from the "comment"
- portion of an email message's From: header.
-
- It returns (FoundInExternalDatabase, ParamHash);
-
- FoundInExternalDatabase must be set to 1 before return if the user
- was found in the external database.
-
- ParamHash is a Perl parameter hash which can contain at least the
- following fields. These fields are used to populate RT's users
- database when the user is created.
-
- EmailAddress is the email address that RT should use for this user.
- Name is the 'Name' attribute RT should use for this user.
- 'Name' is used for things like access control and user lookups.
- RealName is what RT should display as the user's name when displaying
- 'friendly' names
-
-=cut
-
-sub LookupExternalUserInfo {
- my $self = shift;
- my $EmailAddress = shift;
- my $RealName = shift;
-
- my $FoundInExternalDatabase = 1;
- my %params;
-
- #Name is the RT username you want to use for this user.
- $params{'Name'} = $EmailAddress;
- $params{'EmailAddress'} = $EmailAddress;
- $params{'RealName'} = $RealName;
-
- return ($FoundInExternalDatabase, %params);
-}
-
-=head2 Head
-
-Return the parsed head from this message
-
-=cut
-
-sub Head {
- my $self = shift;
- return $self->Entity->head;
-}
-
-=head2 Entity
-
-Return the parsed Entity from this message
-
-=cut
-
-sub Entity {
- my $self = shift;
- return $self->{'entity'};
-}
-
-
-
-=head2 _SetupMIMEParser $parser
-
-A private instance method which sets up a mime parser to do its job
-
-=cut
-
-
- ## TODO: Does it make sense storing to disk at all? After all, we
- ## need to put each msg as an in-core scalar before saving it to
- ## the database, don't we?
-
- ## At the same time, we should make sure that we nuke attachments
- ## Over max size and return them
-
-sub _SetupMIMEParser {
- my $self = shift;
- my $parser = shift;
-
- # Set up output directory for files; we use $RT::VarPath instead
- # of File::Spec->tmpdir (e.g., /tmp) beacuse it isn't always
- # writable.
- my $tmpdir;
- if ( -w $RT::VarPath ) {
- $tmpdir = File::Temp::tempdir( DIR => $RT::VarPath, CLEANUP => 1 );
- } elsif (-w File::Spec->tmpdir) {
- $tmpdir = File::Temp::tempdir( TMPDIR => 1, CLEANUP => 1 );
- } else {
- $RT::Logger->crit("Neither the RT var directory ($RT::VarPath) nor the system tmpdir (@{[File::Spec->tmpdir]}) are writable; falling back to in-memory parsing!");
- }
-
- #If someone includes a message, extract it
- $parser->extract_nested_messages(1);
- $parser->extract_uuencode(1); ### default is false
-
- if ($tmpdir) {
- # If we got a writable tmpdir, write to disk
- push ( @{ $self->{'AttachmentDirs'} ||= [] }, $tmpdir );
- $parser->output_dir($tmpdir);
- $parser->filer->ignore_filename(1);
-
- # Set up the prefix for files with auto-generated names:
- $parser->output_prefix("part");
-
- # From the MIME::Parser docs:
- # "Normally, tmpfiles are created when needed during parsing, and destroyed automatically when they go out of scope"
- # Turns out that the default is to recycle tempfiles
- # Temp files should never be recycled, especially when running under perl taint checking
-
- $parser->tmp_recycling(0) if $parser->can('tmp_recycling');
- } else {
- # Otherwise, fall back to storing it in memory
- $parser->output_to_core(1);
- $parser->tmp_to_core(1);
- $parser->use_inner_files(1);
- }
-
-}
-
-=head2 ParseEmailAddress string
-
-Returns a list of Email::Address objects
-Works around the bug that Email::Address 1.889 and earlier
-doesn't handle local-only email addresses (when users pass
-in just usernames on the RT system in fields that expect
-Email Addresses)
-
-We don't handle the case of
-bob, fred@bestpractical.com
-because we don't want to fail parsing
-bob, "Falcone, Fred" <fred@bestpractical.com>
-The next release of Email::Address will have a new method
-we can use that removes the bandaid
-
-=cut
-
-sub ParseEmailAddress {
- my $self = shift;
- my $address_string = shift;
-
- $address_string =~ s/^\s+|\s+$//g;
-
- my @addresses;
- # if it looks like a username / local only email
- if ($address_string !~ /@/ && $address_string =~ /^\w+$/) {
- my $user = RT::User->new( RT->SystemUser );
- my ($id, $msg) = $user->Load($address_string);
- if ($id) {
- push @addresses, Email::Address->new($user->Name,$user->EmailAddress);
- } else {
- $RT::Logger->error("Unable to parse an email address from $address_string: $msg");
- }
- } else {
- @addresses = Email::Address->parse($address_string);
- }
-
- $self->CleanupAddresses(@addresses);
-
- return @addresses;
-
-}
-
-=head2 CleanupAddresses ARRAY
-
-Massages an array of L<Email::Address> objects to make their email addresses
-more palatable.
-
-Currently this strips off surrounding single quotes around C<< ->address >> and
-B<< modifies the L<Email::Address> objects in-place >>.
-
-Returns the list of objects for convienence in C<map>/C<grep> chains.
-
-=cut
-
-sub CleanupAddresses {
- my $self = shift;
-
- for my $addr (@_) {
- next unless defined $addr;
- # Outlook sometimes sends addresses surrounded by single quotes;
- # clean them all up
- if ((my $email = $addr->address) =~ s/^'(.+)'$/$1/) {
- $addr->address($email);
- }
- }
- return @_;
-}
-
-=head2 RescueOutlook
-
-Outlook 2007/2010 have a bug when you write an email with the html format.
-it will send a 'multipart/alternative' with both 'text/plain' and 'text/html'
-in it. it's cool to have a 'text/plain' part, but the problem is the part is
-not so right: all the "\n" in your main message will become "\n\n" :/
-
-this method will fix this bug, i.e. replaces "\n\n" to "\n".
-return 1 if it does find the problem in the entity and get it fixed.
-
-=cut
-
-
-sub RescueOutlook {
- my $self = shift;
- my $mime = $self->Entity();
- return unless $mime && $self->LooksLikeMSEmail($mime);
-
- my $text_part;
- if ( $mime->head->get('Content-Type') =~ m{multipart/mixed} ) {
- my $first = $mime->parts(0);
- if ( $first && $first->head->get('Content-Type') =~ m{multipart/alternative} )
- {
- my $inner_first = $first->parts(0);
- if ( $inner_first && $inner_first->head->get('Content-Type') =~ m{text/plain} )
- {
- $text_part = $inner_first;
- }
- }
- }
- elsif ( $mime->head->get('Content-Type') =~ m{multipart/alternative} ) {
- my $first = $mime->parts(0);
- if ( $first && $first->head->get('Content-Type') =~ m{text/plain} ) {
- $text_part = $first;
- }
- }
-
- # Add base64 since we've seen examples of double newlines with
- # this type too. Need an example of a multi-part base64 to
- # handle that permutation if it exists.
- elsif ( $mime->head->get('Content-Transfer-Encoding') =~ m{base64} ) {
- $text_part = $mime; # Assuming single part, already decoded.
- }
-
- if ($text_part) {
-
- # use the unencoded string
- my $content = $text_part->bodyhandle->as_string;
- if ( $content =~ s/\n\n/\n/g ) {
-
- # Outlook puts a space on extra newlines, remove it
- $content =~ s/\ +$//mg;
-
- # only write only if we did change the content
- if ( my $io = $text_part->open("w") ) {
- $io->print($content);
- $io->close;
- $RT::Logger->debug(
- "Removed extra newlines from MS Outlook message.");
- return 1;
- }
- else {
- $RT::Logger->error("Can't write to body to fix newlines");
- }
- }
- }
-
- return;
-}
-
-=head1 LooksLikeMSEmail
-
-Try to determine if the current email may have
-come from MS Outlook or gone through Exchange, and therefore
-may have extra newlines added.
-
-=cut
-
-sub LooksLikeMSEmail {
- my $self = shift;
- my $mime = shift;
-
- my $mailer = $mime->head->get('X-Mailer');
-
- # 12.0 is outlook 2007, 14.0 is 2010
- return 1 if ( $mailer && $mailer =~ /Microsoft(?:.*?)Outlook 1[2-4]\./ );
-
- if ( RT->Config->Get('CheckMoreMSMailHeaders') ) {
-
- # Check for additional headers that might
- # indicate this came from Outlook or through Exchange.
- # A sample we received had the headers X-MS-Has-Attach: and
- # X-MS-Tnef-Correlator: and both had no value.
-
- my @tags = $mime->head->tags();
- return 1 if grep { /^X-MS-/ } @tags;
- }
-
- return 0; # Doesn't look like MS email.
-}
-
-sub DESTROY {
- my $self = shift;
- File::Path::rmtree([@{$self->{'AttachmentDirs'}}],0,1)
- if $self->{'AttachmentDirs'};
-}
-
-
-
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-=head1 NAME
-
- RT::Record - Base class for RT record objects
-
-=head1 SYNOPSIS
-
-
-=head1 DESCRIPTION
-
-
-
-=head1 METHODS
-
-=cut
-
-package RT::Record;
-
-use strict;
-use warnings;
-
-
-use RT::Date;
-use RT::I18N;
-use RT::User;
-use RT::Attributes;
-use Encode qw();
-
-our $_TABLE_ATTR = { };
-use base RT->Config->Get('RecordBaseClass');
-use base 'RT::Base';
-
-
-sub _Init {
- my $self = shift;
- $self->_BuildTableAttributes unless ($_TABLE_ATTR->{ref($self)});
- $self->CurrentUser(@_);
-}
-
-
-
-=head2 _PrimaryKeys
-
-The primary keys for RT classes is 'id'
-
-=cut
-
-sub _PrimaryKeys { return ['id'] }
-# short circuit many, many thousands of calls from searchbuilder
-sub _PrimaryKey { 'id' }
-
-=head2 Id
-
-Override L<DBIx::SearchBuilder/Id> to avoid a few lookups RT doesn't do
-on a very common codepath
-
-C<id> is an alias to C<Id> and is the preferred way to call this method.
-
-=cut
-
-sub Id {
- return shift->{'values'}->{id};
-}
-
-*id = \&Id;
-
-=head2 Delete
-
-Delete this record object from the database.
-
-=cut
-
-sub Delete {
- my $self = shift;
- my ($rv) = $self->SUPER::Delete;
- if ($rv) {
- return ($rv, $self->loc("Object deleted"));
- } else {
-
- return(0, $self->loc("Object could not be deleted"))
- }
-}
-
-=head2 ObjectTypeStr
-
-Returns a string which is this object's type. The type is the class,
-without the "RT::" prefix.
-
-
-=cut
-
-sub ObjectTypeStr {
- my $self = shift;
- if (ref($self) =~ /^.*::(\w+)$/) {
- return $self->loc($1);
- } else {
- return $self->loc(ref($self));
- }
-}
-
-=head2 Attributes
-
-Return this object's attributes as an RT::Attributes object
-
-=cut
-
-sub Attributes {
- my $self = shift;
- unless ($self->{'attributes'}) {
- $self->{'attributes'} = RT::Attributes->new($self->CurrentUser);
- $self->{'attributes'}->LimitToObject($self);
- $self->{'attributes'}->OrderByCols({FIELD => 'id'});
- }
- return ($self->{'attributes'});
-}
-
-
-=head2 AddAttribute { Name, Description, Content }
-
-Adds a new attribute for this object.
-
-=cut
-
-sub AddAttribute {
- my $self = shift;
- my %args = ( Name => undef,
- Description => undef,
- Content => undef,
- @_ );
-
- my $attr = RT::Attribute->new( $self->CurrentUser );
- my ( $id, $msg ) = $attr->Create(
- Object => $self,
- Name => $args{'Name'},
- Description => $args{'Description'},
- Content => $args{'Content'} );
-
-
- # XXX TODO: Why won't RedoSearch work here?
- $self->Attributes->_DoSearch;
-
- return ($id, $msg);
-}
-
-
-=head2 SetAttribute { Name, Description, Content }
-
-Like AddAttribute, but replaces all existing attributes with the same Name.
-
-=cut
-
-sub SetAttribute {
- my $self = shift;
- my %args = ( Name => undef,
- Description => undef,
- Content => undef,
- @_ );
-
- my @AttributeObjs = $self->Attributes->Named( $args{'Name'} )
- or return $self->AddAttribute( %args );
-
- my $AttributeObj = pop( @AttributeObjs );
- $_->Delete foreach @AttributeObjs;
-
- $AttributeObj->SetDescription( $args{'Description'} );
- $AttributeObj->SetContent( $args{'Content'} );
-
- $self->Attributes->RedoSearch;
- return 1;
-}
-
-=head2 DeleteAttribute NAME
-
-Deletes all attributes with the matching name for this object.
-
-=cut
-
-sub DeleteAttribute {
- my $self = shift;
- my $name = shift;
- my ($val,$msg) = $self->Attributes->DeleteEntry( Name => $name );
- $self->ClearAttributes;
- return ($val,$msg);
-}
-
-=head2 FirstAttribute NAME
-
-Returns the first attribute with the matching name for this object (as an
-L<RT::Attribute> object), or C<undef> if no such attributes exist.
-If there is more than one attribute with the matching name on the
-object, the first value that was set is returned.
-
-=cut
-
-sub FirstAttribute {
- my $self = shift;
- my $name = shift;
- return ($self->Attributes->Named( $name ))[0];
-}
-
-
-sub ClearAttributes {
- my $self = shift;
- delete $self->{'attributes'};
-
-}
-
-sub _Handle { return $RT::Handle }
-
-
-
-=head2 Create PARAMHASH
-
-Takes a PARAMHASH of Column -> Value pairs.
-If any Column has a Validate$PARAMNAME subroutine defined and the
-value provided doesn't pass validation, this routine returns
-an error.
-
-If this object's table has any of the following atetributes defined as
-'Auto', this routine will automatically fill in their values.
-
-=over
-
-=item Created
-
-=item Creator
-
-=item LastUpdated
-
-=item LastUpdatedBy
-
-=back
-
-=cut
-
-sub Create {
- my $self = shift;
- my %attribs = (@_);
- foreach my $key ( keys %attribs ) {
- if (my $method = $self->can("Validate$key")) {
- if (! $method->( $self, $attribs{$key} ) ) {
- if (wantarray) {
- return ( 0, $self->loc('Invalid value for [_1]', $key) );
- }
- else {
- return (0);
- }
- }
- }
- }
-
-
-
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$ydaym,$isdst,$offset) = gmtime();
-
- my $now_iso =
- sprintf("%04d-%02d-%02d %02d:%02d:%02d", ($year+1900), ($mon+1), $mday, $hour, $min, $sec);
-
- $attribs{'Created'} = $now_iso if ( $self->_Accessible( 'Created', 'auto' ) && !$attribs{'Created'});
-
- if ($self->_Accessible( 'Creator', 'auto' ) && !$attribs{'Creator'}) {
- $attribs{'Creator'} = $self->CurrentUser->id || '0';
- }
- $attribs{'LastUpdated'} = $now_iso
- if ( $self->_Accessible( 'LastUpdated', 'auto' ) && !$attribs{'LastUpdated'});
-
- $attribs{'LastUpdatedBy'} = $self->CurrentUser->id || '0'
- if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) && !$attribs{'LastUpdatedBy'});
-
- my $id = $self->SUPER::Create(%attribs);
- if ( UNIVERSAL::isa( $id, 'Class::ReturnValue' ) ) {
- if ( $id->errno ) {
- if (wantarray) {
- return ( 0,
- $self->loc( "Internal Error: [_1]", $id->{error_message} ) );
- }
- else {
- return (0);
- }
- }
- }
- # If the object was created in the database,
- # load it up now, so we're sure we get what the database
- # has. Arguably, this should not be necessary, but there
- # isn't much we can do about it.
-
- unless ($id) {
- if (wantarray) {
- return ( $id, $self->loc('Object could not be created') );
- }
- else {
- return ($id);
- }
-
- }
-
- if (UNIVERSAL::isa('errno',$id)) {
- return(undef);
- }
-
- $self->Load($id) if ($id);
-
-
-
- if (wantarray) {
- return ( $id, $self->loc('Object created') );
- }
- else {
- return ($id);
- }
-
-}
-
-
-
-=head2 LoadByCols
-
-Override DBIx::SearchBuilder::LoadByCols to do case-insensitive loads if the
-DB is case sensitive
-
-=cut
-
-sub LoadByCols {
- my $self = shift;
-
- # We don't want to hang onto this
- $self->ClearAttributes;
-
- return $self->SUPER::LoadByCols( @_ ) unless $self->_Handle->CaseSensitive;
-
- # If this database is case sensitive we need to uncase objects for
- # explicit loading
- my %hash = (@_);
- foreach my $key ( keys %hash ) {
-
- # If we've been passed an empty value, we can't do the lookup.
- # We don't need to explicitly downcase integers or an id.
- if ( $key ne 'id' && defined $hash{ $key } && $hash{ $key } !~ /^\d+$/ ) {
- my ($op, $val, $func);
- ($key, $op, $val, $func) =
- $self->_Handle->_MakeClauseCaseInsensitive( $key, '=', delete $hash{ $key } );
- $hash{$key}->{operator} = $op;
- $hash{$key}->{value} = $val;
- $hash{$key}->{function} = $func;
- }
- }
- return $self->SUPER::LoadByCols( %hash );
-}
-
-
-
-# There is room for optimizations in most of those subs:
-
-
-sub LastUpdatedObj {
- my $self = shift;
- my $obj = RT::Date->new( $self->CurrentUser );
-
- $obj->Set( Format => 'sql', Value => $self->LastUpdated );
- return $obj;
-}
-
-
-
-sub CreatedObj {
- my $self = shift;
- my $obj = RT::Date->new( $self->CurrentUser );
-
- $obj->Set( Format => 'sql', Value => $self->Created );
-
- return $obj;
-}
-
-
-#
-# TODO: This should be deprecated
-#
-sub AgeAsString {
- my $self = shift;
- return ( $self->CreatedObj->AgeAsString() );
-}
-
-
-
-# TODO this should be deprecated
-
-sub LastUpdatedAsString {
- my $self = shift;
- if ( $self->LastUpdated ) {
- return ( $self->LastUpdatedObj->AsString() );
-
- }
- else {
- return "never";
- }
-}
-
-
-#
-# TODO This should be deprecated
-#
-sub CreatedAsString {
- my $self = shift;
- return ( $self->CreatedObj->AsString() );
-}
-
-
-#
-# TODO This should be deprecated
-#
-sub LongSinceUpdateAsString {
- my $self = shift;
- if ( $self->LastUpdated ) {
-
- return ( $self->LastUpdatedObj->AgeAsString() );
-
- }
- else {
- return "never";
- }
-}
-
-
-
-#
-sub _Set {
- my $self = shift;
-
- my %args = (
- Field => undef,
- Value => undef,
- IsSQL => undef,
- @_
- );
-
- #if the user is trying to modify the record
- # TODO: document _why_ this code is here
-
- if ( ( !defined( $args{'Field'} ) ) || ( !defined( $args{'Value'} ) ) ) {
- $args{'Value'} = 0;
- }
-
- my $old_val = $self->__Value($args{'Field'});
- $self->_SetLastUpdated();
- my $ret = $self->SUPER::_Set(
- Field => $args{'Field'},
- Value => $args{'Value'},
- IsSQL => $args{'IsSQL'}
- );
- my ($status, $msg) = $ret->as_array();
-
- # @values has two values, a status code and a message.
-
- # $ret is a Class::ReturnValue object. as such, in a boolean context, it's a bool
- # we want to change the standard "success" message
- if ($status) {
- if ($self->SQLType( $args{'Field'}) =~ /text/) {
- $msg = $self->loc(
- "[_1] updated",
- $self->loc( $args{'Field'} ),
- );
- } else {
- $msg = $self->loc(
- "[_1] changed from [_2] to [_3]",
- $self->loc( $args{'Field'} ),
- ( $old_val ? '"' . $old_val . '"' : $self->loc("(no value)") ),
- '"' . $self->__Value( $args{'Field'}) . '"',
- );
- }
- } else {
- $msg = $self->CurrentUser->loc_fuzzy($msg);
- }
-
- return wantarray ? ($status, $msg) : $ret;
-}
-
-
-
-=head2 _SetLastUpdated
-
-This routine updates the LastUpdated and LastUpdatedBy columns of the row in question
-It takes no options. Arguably, this is a bug
-
-=cut
-
-sub _SetLastUpdated {
- my $self = shift;
- use RT::Date;
- my $now = RT::Date->new( $self->CurrentUser );
- $now->SetToNow();
-
- if ( $self->_Accessible( 'LastUpdated', 'auto' ) ) {
- my ( $msg, $val ) = $self->__Set(
- Field => 'LastUpdated',
- Value => $now->ISO
- );
- }
- if ( $self->_Accessible( 'LastUpdatedBy', 'auto' ) ) {
- my ( $msg, $val ) = $self->__Set(
- Field => 'LastUpdatedBy',
- Value => $self->CurrentUser->id
- );
- }
-}
-
-
-
-=head2 CreatorObj
-
-Returns an RT::User object with the RT account of the creator of this row
-
-=cut
-
-sub CreatorObj {
- my $self = shift;
- unless ( exists $self->{'CreatorObj'} ) {
-
- $self->{'CreatorObj'} = RT::User->new( $self->CurrentUser );
- $self->{'CreatorObj'}->Load( $self->Creator );
- }
- return ( $self->{'CreatorObj'} );
-}
-
-
-
-=head2 LastUpdatedByObj
-
- Returns an RT::User object of the last user to touch this object
-
-=cut
-
-sub LastUpdatedByObj {
- my $self = shift;
- unless ( exists $self->{LastUpdatedByObj} ) {
- $self->{'LastUpdatedByObj'} = RT::User->new( $self->CurrentUser );
- $self->{'LastUpdatedByObj'}->Load( $self->LastUpdatedBy );
- }
- return $self->{'LastUpdatedByObj'};
-}
-
-
-
-=head2 URI
-
-Returns this record's URI
-
-=cut
-
-sub URI {
- my $self = shift;
- my $uri = RT::URI::fsck_com_rt->new($self->CurrentUser);
- return($uri->URIForObject($self));
-}
-
-
-=head2 ValidateName NAME
-
-Validate the name of the record we're creating. Mostly, just make sure it's not a numeric ID, which is invalid for Name
-
-=cut
-
-sub ValidateName {
- my $self = shift;
- my $value = shift;
- if (defined $value && $value=~ /^\d+$/) {
- return(0);
- } else {
- return(1);
- }
-}
-
-
-
-=head2 SQLType attribute
-
-return the SQL type for the attribute 'attribute' as stored in _ClassAccessible
-
-=cut
-
-sub SQLType {
- my $self = shift;
- my $field = shift;
-
- return ($self->_Accessible($field, 'type'));
-
-
-}
-
-sub __Value {
- my $self = shift;
- my $field = shift;
- my %args = ( decode_utf8 => 1, @_ );
-
- unless ($field) {
- $RT::Logger->error("__Value called with undef field");
- }
-
- my $value = $self->SUPER::__Value($field);
-
- return undef if (!defined $value);
-
- if ( $args{'decode_utf8'} ) {
- if ( !utf8::is_utf8($value) ) {
- utf8::decode($value);
- }
- }
- else {
- if ( utf8::is_utf8($value) ) {
- utf8::encode($value);
- }
- }
-
- return $value;
-
-}
-
-# Set up defaults for DBIx::SearchBuilder::Record::Cachable
-
-sub _CacheConfig {
- {
- 'cache_p' => 1,
- 'cache_for_sec' => 30,
- }
-}
-
-
-
-sub _BuildTableAttributes {
- my $self = shift;
- my $class = ref($self) || $self;
-
- my $attributes;
- if ( UNIVERSAL::can( $self, '_CoreAccessible' ) ) {
- $attributes = $self->_CoreAccessible();
- } elsif ( UNIVERSAL::can( $self, '_ClassAccessible' ) ) {
- $attributes = $self->_ClassAccessible();
-
- }
-
- foreach my $column (keys %$attributes) {
- foreach my $attr ( keys %{ $attributes->{$column} } ) {
- $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
- }
- }
- foreach my $method ( qw(_OverlayAccessible _VendorAccessible _LocalAccessible) ) {
- next unless UNIVERSAL::can( $self, $method );
- $attributes = $self->$method();
-
- foreach my $column ( keys %$attributes ) {
- foreach my $attr ( keys %{ $attributes->{$column} } ) {
- $_TABLE_ATTR->{$class}->{$column}->{$attr} = $attributes->{$column}->{$attr};
- }
- }
- }
-}
-
-
-=head2 _ClassAccessible
-
-Overrides the "core" _ClassAccessible using $_TABLE_ATTR. Behaves identical to the version in
-DBIx::SearchBuilder::Record
-
-=cut
-
-sub _ClassAccessible {
- my $self = shift;
- return $_TABLE_ATTR->{ref($self) || $self};
-}
-
-=head2 _Accessible COLUMN ATTRIBUTE
-
-returns the value of ATTRIBUTE for COLUMN
-
-
-=cut
-
-sub _Accessible {
- my $self = shift;
- my $column = shift;
- my $attribute = lc(shift);
- return 0 unless defined ($_TABLE_ATTR->{ref($self)}->{$column});
- return $_TABLE_ATTR->{ref($self)}->{$column}->{$attribute} || 0;
-
-}
-
-=head2 _EncodeLOB BODY MIME_TYPE FILENAME
-
-Takes a potentially large attachment. Returns (ContentEncoding,
-EncodedBody, MimeType, Filename) based on system configuration and
-selected database. Returns a custom (short) text/plain message if
-DropLongAttachments causes an attachment to not be stored.
-
-Encodes your data as base64 or Quoted-Printable as needed based on your
-Databases's restrictions and the UTF-8ness of the data being passed in. Since
-we are storing in columns marked UTF8, we must ensure that binary data is
-encoded on databases which are strict.
-
-This function expects to receive an octet string in order to properly
-evaluate and encode it. It will return an octet string.
-
-=cut
-
-sub _EncodeLOB {
- my $self = shift;
- my $Body = shift;
- my $MIMEType = shift || '';
- my $Filename = shift;
-
- my $ContentEncoding = 'none';
-
- #get the max attachment length from RT
- my $MaxSize = RT->Config->Get('MaxAttachmentSize');
-
- #if the current attachment contains nulls and the
- #database doesn't support embedded nulls
-
- if ( ( !$RT::Handle->BinarySafeBLOBs ) && ( $Body =~ /\x00/ ) ) {
-
- # set a flag telling us to mimencode the attachment
- $ContentEncoding = 'base64';
-
- #cut the max attchment size by 25% (for mime-encoding overhead.
- $RT::Logger->debug("Max size is $MaxSize");
- $MaxSize = $MaxSize * 3 / 4;
- # Some databases (postgres) can't handle non-utf8 data
- } elsif ( !$RT::Handle->BinarySafeBLOBs
- && $Body =~ /\P{ASCII}/
- && !Encode::is_utf8( $Body, 1 ) ) {
- $ContentEncoding = 'quoted-printable';
- }
-
- #if the attachment is larger than the maximum size
- if ( ($MaxSize) and ( $MaxSize < length($Body) ) ) {
-
- # if we're supposed to truncate large attachments
- if (RT->Config->Get('TruncateLongAttachments')) {
-
- # truncate the attachment to that length.
- $Body = substr( $Body, 0, $MaxSize );
-
- }
-
- # elsif we're supposed to drop large attachments on the floor,
- elsif (RT->Config->Get('DropLongAttachments')) {
-
- # drop the attachment on the floor
- $RT::Logger->info( "$self: Dropped an attachment of size "
- . length($Body));
- $RT::Logger->info( "It started: " . substr( $Body, 0, 60 ) );
- $Filename .= ".txt" if $Filename;
- return ("none", "Large attachment dropped", "text/plain", $Filename );
- }
- }
-
- # if we need to mimencode the attachment
- if ( $ContentEncoding eq 'base64' ) {
-
- # base64 encode the attachment
- Encode::_utf8_off($Body);
- $Body = MIME::Base64::encode_base64($Body);
-
- } elsif ($ContentEncoding eq 'quoted-printable') {
- Encode::_utf8_off($Body);
- $Body = MIME::QuotedPrint::encode($Body);
- }
-
-
- return ($ContentEncoding, $Body, $MIMEType, $Filename );
-
-}
-
-=head2 _DecodeLOB
-
-Unpacks data stored in the database, which may be base64 or QP encoded
-because of our need to store binary and badly encoded data in columns
-marked as UTF-8. Databases such as PostgreSQL and Oracle care that you
-are feeding them invalid UTF-8 and will refuse the content. This
-function handles unpacking the encoded data.
-
-It returns textual data as a UTF-8 string which has been processed by Encode's
-PERLQQ filter which will replace the invalid bytes with \x{HH} so you can see
-the invalid byte but won't run into problems treating the data as UTF-8 later.
-
-This is similar to how we filter all data coming in via the web UI in
-RT::Interface::Web::DecodeARGS. This filter should only end up being
-applied to old data from less UTF-8-safe versions of RT.
-
-Important Note - This function expects an octet string and returns a
-character string for non-binary data.
-
-=cut
-
-sub _DecodeLOB {
- my $self = shift;
- my $ContentType = shift || '';
- my $ContentEncoding = shift || 'none';
- my $Content = shift;
-
- if ( $ContentEncoding eq 'base64' ) {
- $Content = MIME::Base64::decode_base64($Content);
- }
- elsif ( $ContentEncoding eq 'quoted-printable' ) {
- $Content = MIME::QuotedPrint::decode($Content);
- }
- elsif ( $ContentEncoding && $ContentEncoding ne 'none' ) {
- return ( $self->loc( "Unknown ContentEncoding [_1]", $ContentEncoding ) );
- }
- if ( RT::I18N::IsTextualContentType($ContentType) ) {
- $Content = Encode::decode('UTF-8',$Content,Encode::FB_PERLQQ) unless Encode::is_utf8($Content);
- }
- return ($Content);
-}
-
-# A helper table for links mapping to make it easier
-# to build and parse links between tickets
-
-use vars '%LINKDIRMAP';
-
-%LINKDIRMAP = (
- MemberOf => { Base => 'MemberOf',
- Target => 'HasMember', },
- RefersTo => { Base => 'RefersTo',
- Target => 'ReferredToBy', },
- DependsOn => { Base => 'DependsOn',
- Target => 'DependedOnBy', },
- MergedInto => { Base => 'MergedInto',
- Target => 'MergedInto', },
-
-);
-
-=head2 Update ARGSHASH
-
-Updates fields on an object for you using the proper Set methods,
-skipping unchanged values.
-
- ARGSRef => a hashref of attributes => value for the update
- AttributesRef => an arrayref of keys in ARGSRef that should be updated
- AttributePrefix => a prefix that should be added to the attributes in AttributesRef
- when looking up values in ARGSRef
- Bare attributes are tried before prefixed attributes
-
-Returns a list of localized results of the update
-
-=cut
-
-sub Update {
- my $self = shift;
-
- my %args = (
- ARGSRef => undef,
- AttributesRef => undef,
- AttributePrefix => undef,
- @_
- );
-
- my $attributes = $args{'AttributesRef'};
- my $ARGSRef = $args{'ARGSRef'};
- my %new_values;
-
- # gather all new values
- foreach my $attribute (@$attributes) {
- my $value;
- if ( defined $ARGSRef->{$attribute} ) {
- $value = $ARGSRef->{$attribute};
- }
- elsif (
- defined( $args{'AttributePrefix'} )
- && defined(
- $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute }
- )
- ) {
- $value = $ARGSRef->{ $args{'AttributePrefix'} . "-" . $attribute };
-
- }
- else {
- next;
- }
-
- $value =~ s/\r\n/\n/gs;
-
- my $truncated_value = $self->TruncateValue($attribute, $value);
-
- # If Queue is 'General', we want to resolve the queue name for
- # the object.
-
- # This is in an eval block because $object might not exist.
- # and might not have a Name method. But "can" won't find autoloaded
- # items. If it fails, we don't care
- do {
- no warnings "uninitialized";
- local $@;
- eval {
- my $object = $attribute . "Obj";
- my $name = $self->$object->Name;
- next if $name eq $value || $name eq ($value || 0);
- };
-
- my $current = $self->$attribute();
- # RT::Queue->Lifecycle returns a Lifecycle object instead of name
- $current = eval { $current->Name } if ref $current;
- next if $truncated_value eq $current;
- next if ( $truncated_value || 0 ) eq $current;
- };
-
- $new_values{$attribute} = $value;
- }
-
- return $self->_UpdateAttributes(
- Attributes => $attributes,
- NewValues => \%new_values,
- );
-}
-
-sub _UpdateAttributes {
- my $self = shift;
- my %args = (
- Attributes => [],
- NewValues => {},
- @_,
- );
-
- my @results;
-
- foreach my $attribute (@{ $args{Attributes} }) {
- next if !exists($args{NewValues}{$attribute});
-
- my $value = $args{NewValues}{$attribute};
- my $method = "Set$attribute";
- my ( $code, $msg ) = $self->$method($value);
- my ($prefix) = ref($self) =~ /RT(?:.*)::(\w+)/;
-
- # Default to $id, but use name if we can get it.
- my $label = $self->id;
- $label = $self->Name if (UNIVERSAL::can($self,'Name'));
- # this requires model names to be loc'ed.
-
-=for loc
-
- "Ticket" # loc
- "User" # loc
- "Group" # loc
- "Queue" # loc
-
-=cut
-
- push @results, $self->loc( $prefix ) . " $label: ". $msg;
-
-=for loc
-
- "[_1] could not be set to [_2].", # loc
- "That is already the current value", # loc
- "No value sent to _Set!", # loc
- "Illegal value for [_1]", # loc
- "The new value has been set.", # loc
- "No column specified", # loc
- "Immutable field", # loc
- "Nonexistant field?", # loc
- "Invalid data", # loc
- "Couldn't find row", # loc
- "Missing a primary key?: [_1]", # loc
- "Found Object", # loc
-
-=cut
-
- }
-
- return @results;
-}
-
-
-
-
-=head2 Members
-
- This returns an RT::Links object which references all the tickets
-which are 'MembersOf' this ticket
-
-=cut
-
-sub Members {
- my $self = shift;
- return ( $self->_Links( 'Target', 'MemberOf' ) );
-}
-
-
-
-=head2 MemberOf
-
- This returns an RT::Links object which references all the tickets that this
-ticket is a 'MemberOf'
-
-=cut
-
-sub MemberOf {
- my $self = shift;
- return ( $self->_Links( 'Base', 'MemberOf' ) );
-}
-
-
-
-=head2 RefersTo
-
- This returns an RT::Links object which shows all references for which this ticket is a base
-
-=cut
-
-sub RefersTo {
- my $self = shift;
- return ( $self->_Links( 'Base', 'RefersTo' ) );
-}
-
-
-
-=head2 ReferredToBy
-
-This returns an L<RT::Links> object which shows all references for which this ticket is a target
-
-=cut
-
-sub ReferredToBy {
- my $self = shift;
- return ( $self->_Links( 'Target', 'RefersTo' ) );
-}
-
-
-
-=head2 DependedOnBy
-
- This returns an RT::Links object which references all the tickets that depend on this one
-
-=cut
-
-sub DependedOnBy {
- my $self = shift;
- return ( $self->_Links( 'Target', 'DependsOn' ) );
-}
-
-
-
-
-=head2 HasUnresolvedDependencies
-
-Takes a paramhash of Type (default to '__any'). Returns the number of
-unresolved dependencies, if $self->UnresolvedDependencies returns an
-object with one or more members of that type. Returns false
-otherwise.
-
-=cut
-
-sub HasUnresolvedDependencies {
- my $self = shift;
- my %args = (
- Type => undef,
- @_
- );
-
- my $deps = $self->UnresolvedDependencies;
-
- if ($args{Type}) {
- $deps->Limit( FIELD => 'Type',
- OPERATOR => '=',
- VALUE => $args{Type});
- }
- else {
- $deps->IgnoreType;
- }
-
- if ($deps->Count > 0) {
- return $deps->Count;
- }
- else {
- return (undef);
- }
-}
-
-
-
-=head2 UnresolvedDependencies
-
-Returns an RT::Tickets object of tickets which this ticket depends on
-and which have a status of new, open or stalled. (That list comes from
-RT::Queue->ActiveStatusArray
-
-=cut
-
-
-sub UnresolvedDependencies {
- my $self = shift;
- my $deps = RT::Tickets->new($self->CurrentUser);
-
- my @live_statuses = RT::Queue->ActiveStatusArray();
- foreach my $status (@live_statuses) {
- $deps->LimitStatus(VALUE => $status);
- }
- $deps->LimitDependedOnBy($self->Id);
-
- return($deps);
-
-}
-
-
-
-=head2 AllDependedOnBy
-
-Returns an array of RT::Ticket objects which (directly or indirectly)
-depends on this ticket; takes an optional 'Type' argument in the param
-hash, which will limit returned tickets to that type, as well as cause
-tickets with that type to serve as 'leaf' nodes that stops the recursive
-dependency search.
-
-=cut
-
-sub AllDependedOnBy {
- my $self = shift;
- return $self->_AllLinkedTickets( LinkType => 'DependsOn',
- Direction => 'Target', @_ );
-}
-
-=head2 AllDependsOn
-
-Returns an array of RT::Ticket objects which this ticket (directly or
-indirectly) depends on; takes an optional 'Type' argument in the param
-hash, which will limit returned tickets to that type, as well as cause
-tickets with that type to serve as 'leaf' nodes that stops the
-recursive dependency search.
-
-=cut
-
-sub AllDependsOn {
- my $self = shift;
- return $self->_AllLinkedTickets( LinkType => 'DependsOn',
- Direction => 'Base', @_ );
-}
-
-sub _AllLinkedTickets {
- my $self = shift;
-
- my %args = (
- LinkType => undef,
- Direction => undef,
- Type => undef,
- _found => {},
- _top => 1,
- @_
- );
-
- my $dep = $self->_Links( $args{Direction}, $args{LinkType});
- while (my $link = $dep->Next()) {
- my $uri = $args{Direction} eq 'Target' ? $link->BaseURI : $link->TargetURI;
- next unless ($uri->IsLocal());
- my $obj = $args{Direction} eq 'Target' ? $link->BaseObj : $link->TargetObj;
- next if $args{_found}{$obj->Id};
-
- if (!$args{Type}) {
- $args{_found}{$obj->Id} = $obj;
- $obj->_AllLinkedTickets( %args, _top => 0 );
- }
- elsif ($obj->Type and $obj->Type eq $args{Type}) {
- $args{_found}{$obj->Id} = $obj;
- }
- else {
- $obj->_AllLinkedTickets( %args, _top => 0 );
- }
- }
-
- if ($args{_top}) {
- return map { $args{_found}{$_} } sort keys %{$args{_found}};
- }
- else {
- return 1;
- }
-}
-
-
-
-=head2 DependsOn
-
- This returns an RT::Links object which references all the tickets that this ticket depends on
-
-=cut
-
-sub DependsOn {
- my $self = shift;
- return ( $self->_Links( 'Base', 'DependsOn' ) );
-}
-
-# }}}
-
-# {{{ Customers
-
-=head2 Customers
-
- This returns an RT::Links object which references all the customers that
- this object is a member of. This includes both explicitly linked customers
- and links implied by services.
-
-=cut
-
-sub Customers {
- my( $self, %opt ) = @_;
- my $Debug = $opt{'Debug'};
-
- unless ( $self->{'Customers'} ) {
-
- $self->{'Customers'} = $self->MemberOf->Clone;
-
- for my $fstable (qw(cust_main cust_svc)) {
-
- $self->{'Customers'}->Limit(
- FIELD => 'Target',
- OPERATOR => 'STARTSWITH',
- VALUE => "freeside://freeside/$fstable",
- ENTRYAGGREGATOR => 'OR',
- SUBCLAUSE => 'customers',
- );
- }
- }
-
- warn "->Customers method called on $self; returning ".
- ref($self->{'Customers'}). ' object'
- if $Debug;
-
- return $self->{'Customers'};
-}
-
-# }}}
-
-# {{{ Services
-
-=head2 Services
-
- This returns an RT::Links object which references all the services this
- object is a member of.
-
-=cut
-
-sub Services {
- my( $self, %opt ) = @_;
-
- unless ( $self->{'Services'} ) {
-
- $self->{'Services'} = $self->MemberOf->Clone;
-
- $self->{'Services'}->Limit(
- FIELD => 'Target',
- OPERATOR => 'STARTSWITH',
- VALUE => "freeside://freeside/cust_svc",
- );
- }
-
- return $self->{'Services'};
-}
-
-
-
-
-
-
-=head2 Links DIRECTION [TYPE]
-
-Return links (L<RT::Links>) to/from this object.
-
-DIRECTION is either 'Base' or 'Target'.
-
-TYPE is a type of links to return, it can be omitted to get
-links of any type.
-
-=cut
-
-sub Links { shift->_Links(@_) }
-
-sub _Links {
- my $self = shift;
-
- #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
- #tobias meant by $f
- my $field = shift;
- my $type = shift || "";
-
- unless ( $self->{"$field$type"} ) {
- $self->{"$field$type"} = RT::Links->new( $self->CurrentUser );
- # at least to myself
- $self->{"$field$type"}->Limit( FIELD => $field,
- VALUE => $self->URI,
- ENTRYAGGREGATOR => 'OR' );
- $self->{"$field$type"}->Limit( FIELD => 'Type',
- VALUE => $type )
- if ($type);
- }
- return ( $self->{"$field$type"} );
-}
-
-
-
-
-=head2 FormatType
-
-Takes a Type and returns a string that is more human readable.
-
-=cut
-
-sub FormatType{
- my $self = shift;
- my %args = ( Type => '',
- @_
- );
- $args{Type} =~ s/([A-Z])/" " . lc $1/ge;
- $args{Type} =~ s/^\s+//;
- return $args{Type};
-}
-
-
-
-
-=head2 FormatLink
-
-Takes either a Target or a Base and returns a string of human friendly text.
-
-=cut
-
-sub FormatLink {
- my $self = shift;
- my %args = ( Object => undef,
- FallBack => '',
- @_
- );
- my $text = "URI " . $args{FallBack};
- if ($args{Object} && $args{Object}->isa("RT::Ticket")) {
- $text = "Ticket " . $args{Object}->id;
- }
- return $text;
-}
-
-
-
-=head2 _AddLink
-
-Takes a paramhash of Type and one of Base or Target. Adds that link to this object.
-
-Returns C<link id>, C<message> and C<exist> flag.
-
-
-=cut
-
-sub _AddLink {
- my $self = shift;
- my %args = ( Target => '',
- Base => '',
- Type => '',
- Silent => undef,
- @_ );
-
-
- # Remote_link is the URI of the object that is not this ticket
- my $remote_link;
- my $direction;
-
- if ( $args{'Base'} and $args{'Target'} ) {
- $RT::Logger->debug( "$self tried to create a link. both base and target were specified" );
- return ( 0, $self->loc("Can't specify both base and target") );
- }
- elsif ( $args{'Base'} ) {
- $args{'Target'} = $self->URI();
- $remote_link = $args{'Base'};
- $direction = 'Target';
- }
- elsif ( $args{'Target'} ) {
- $args{'Base'} = $self->URI();
- $remote_link = $args{'Target'};
- $direction = 'Base';
- }
- else {
- return ( 0, $self->loc('Either base or target must be specified') );
- }
-
- # Check if the link already exists - we don't want duplicates
- use RT::Link;
- my $old_link = RT::Link->new( $self->CurrentUser );
- $old_link->LoadByParams( Base => $args{'Base'},
- Type => $args{'Type'},
- Target => $args{'Target'} );
- if ( $old_link->Id ) {
- $RT::Logger->debug("$self Somebody tried to duplicate a link");
- return ( $old_link->id, $self->loc("Link already exists"), 1 );
- }
-
- # }}}
-
-
- # Storing the link in the DB.
- my $link = RT::Link->new( $self->CurrentUser );
- my ($linkid, $linkmsg) = $link->Create( Target => $args{Target},
- Base => $args{Base},
- Type => $args{Type} );
-
- unless ($linkid) {
- $RT::Logger->error("Link could not be created: ".$linkmsg);
- return ( 0, $self->loc("Link could not be created") );
- }
-
- my $basetext = $self->FormatLink(Object => $link->BaseObj,
- FallBack => $args{Base});
- my $targettext = $self->FormatLink(Object => $link->TargetObj,
- FallBack => $args{Target});
- my $typetext = $self->FormatType(Type => $args{Type});
- my $TransString =
- "$basetext $typetext $targettext.";
- return ( $linkid, $TransString ) ;
-}
-
-
-
-=head2 _DeleteLink
-
-Delete a link. takes a paramhash of Base, Target and Type.
-Either Base or Target must be null. The null value will
-be replaced with this ticket's id
-
-=cut
-
-sub _DeleteLink {
- my $self = shift;
- my %args = (
- Base => undef,
- Target => undef,
- Type => undef,
- @_
- );
-
- #we want one of base and target. we don't care which
- #but we only want _one_
-
- my $direction;
- my $remote_link;
-
- if ( $args{'Base'} and $args{'Target'} ) {
- $RT::Logger->debug("$self ->_DeleteLink. got both Base and Target");
- return ( 0, $self->loc("Can't specify both base and target") );
- }
- elsif ( $args{'Base'} ) {
- $args{'Target'} = $self->URI();
- $remote_link = $args{'Base'};
- $direction = 'Target';
- }
- elsif ( $args{'Target'} ) {
- $args{'Base'} = $self->URI();
- $remote_link = $args{'Target'};
- $direction='Base';
- }
- else {
- $RT::Logger->error("Base or Target must be specified");
- return ( 0, $self->loc('Either base or target must be specified') );
- }
-
- my $link = RT::Link->new( $self->CurrentUser );
- $RT::Logger->debug( "Trying to load link: " . $args{'Base'} . " " . $args{'Type'} . " " . $args{'Target'} );
-
-
- $link->LoadByParams( Base=> $args{'Base'}, Type=> $args{'Type'}, Target=> $args{'Target'} );
- #it's a real link.
-
- if ( $link->id ) {
- my $basetext = $self->FormatLink(Object => $link->BaseObj,
- FallBack => $args{Base});
- my $targettext = $self->FormatLink(Object => $link->TargetObj,
- FallBack => $args{Target});
- my $typetext = $self->FormatType(Type => $args{Type});
- my $linkid = $link->id;
- $link->Delete();
- my $TransString = "$basetext no longer $typetext $targettext.";
- return ( 1, $TransString);
- }
-
- #if it's not a link we can find
- else {
- $RT::Logger->debug("Couldn't find that link");
- return ( 0, $self->loc("Link not found") );
- }
-}
-
-
-=head1 LockForUpdate
-
-In a database transaction, gains an exclusive lock on the row, to
-prevent race conditions. On SQLite, this is a "RESERVED" lock on the
-entire database.
-
-=cut
-
-sub LockForUpdate {
- my $self = shift;
-
- my $pk = $self->_PrimaryKey;
- my $id = @_ ? $_[0] : $self->$pk;
- $self->_expire if $self->isa("DBIx::SearchBuilder::Record::Cachable");
- if (RT->Config->Get('DatabaseType') eq "SQLite") {
- # SQLite does DB-level locking, upgrading the transaction to
- # "RESERVED" on the first UPDATE/INSERT/DELETE. Do a no-op
- # UPDATE to force the upgade.
- return RT->DatabaseHandle->dbh->do(
- "UPDATE " .$self->Table.
- " SET $pk = $pk WHERE 1 = 0");
- } else {
- return $self->_LoadFromSQL(
- "SELECT * FROM ".$self->Table
- ." WHERE $pk = ? FOR UPDATE",
- $id,
- );
- }
-}
-
-=head2 _NewTransaction PARAMHASH
-
-Private function to create a new RT::Transaction object for this ticket update
-
-=cut
-
-sub _NewTransaction {
- my $self = shift;
- my %args = (
- TimeTaken => undef,
- Type => undef,
- OldValue => undef,
- NewValue => undef,
- OldReference => undef,
- NewReference => undef,
- ReferenceType => undef,
- Data => undef,
- Field => undef,
- MIMEObj => undef,
- ActivateScrips => 1,
- CommitScrips => 1,
- SquelchMailTo => undef,
- CustomFields => {},
- @_
- );
-
- my $in_txn = RT->DatabaseHandle->TransactionDepth;
- RT->DatabaseHandle->BeginTransaction unless $in_txn;
-
- $self->LockForUpdate;
-
- my $old_ref = $args{'OldReference'};
- my $new_ref = $args{'NewReference'};
- my $ref_type = $args{'ReferenceType'};
- if ($old_ref or $new_ref) {
- $ref_type ||= ref($old_ref) || ref($new_ref);
- if (!$ref_type) {
- $RT::Logger->error("Reference type not specified for transaction");
- return;
- }
- $old_ref = $old_ref->Id if ref($old_ref);
- $new_ref = $new_ref->Id if ref($new_ref);
- }
-
- require RT::Transaction;
- my $trans = RT::Transaction->new( $self->CurrentUser );
- my ( $transaction, $msg ) = $trans->Create(
- ObjectId => $self->Id,
- ObjectType => ref($self),
- TimeTaken => $args{'TimeTaken'},
- Type => $args{'Type'},
- Data => $args{'Data'},
- Field => $args{'Field'},
- NewValue => $args{'NewValue'},
- OldValue => $args{'OldValue'},
- NewReference => $new_ref,
- OldReference => $old_ref,
- ReferenceType => $ref_type,
- MIMEObj => $args{'MIMEObj'},
- ActivateScrips => $args{'ActivateScrips'},
- CommitScrips => $args{'CommitScrips'},
- SquelchMailTo => $args{'SquelchMailTo'},
- CustomFields => $args{'CustomFields'},
- );
-
- # Rationalize the object since we may have done things to it during the caching.
- $self->Load($self->Id);
-
- $RT::Logger->warning($msg) unless $transaction;
-
- $self->_SetLastUpdated;
-
- if ( defined $args{'TimeTaken'} and $self->can('_UpdateTimeTaken')) {
- $self->_UpdateTimeTaken( $args{'TimeTaken'} );
- }
- if ( RT->Config->Get('UseTransactionBatch') and $transaction ) {
- push @{$self->{_TransactionBatch}}, $trans if $args{'CommitScrips'};
- }
-
- RT->DatabaseHandle->Commit unless $in_txn;
-
- return ( $transaction, $msg, $trans );
-}
-
-
-
-=head2 Transactions
-
- Returns an RT::Transactions object of all transactions on this record object
-
-=cut
-
-sub Transactions {
- my $self = shift;
-
- use RT::Transactions;
- my $transactions = RT::Transactions->new( $self->CurrentUser );
-
- #If the user has no rights, return an empty object
- $transactions->Limit(
- FIELD => 'ObjectId',
- VALUE => $self->id,
- );
- $transactions->Limit(
- FIELD => 'ObjectType',
- VALUE => ref($self),
- );
-
- return ($transactions);
-}
-
-#
-
-sub CustomFields {
- my $self = shift;
- my $cfs = RT::CustomFields->new( $self->CurrentUser );
-
- $cfs->SetContextObject( $self );
- # XXX handle multiple types properly
- $cfs->LimitToLookupType( $self->CustomFieldLookupType );
- $cfs->LimitToGlobalOrObjectId( $self->CustomFieldLookupId );
- $cfs->ApplySortOrder;
-
- return $cfs;
-}
-
-# TODO: This _only_ works for RT::Foo classes. it doesn't work, for
-# example, for RT::IR::Foo classes.
-
-sub CustomFieldLookupId {
- my $self = shift;
- my $lookup = shift || $self->CustomFieldLookupType;
- my @classes = ($lookup =~ /RT::(\w+)-/g);
-
- # Work on "RT::Queue", for instance
- return $self->Id unless @classes;
-
- my $object = $self;
- # Save a ->Load call by not calling ->FooObj->Id, just ->Foo
- my $final = shift @classes;
- foreach my $class (reverse @classes) {
- my $method = "${class}Obj";
- $object = $object->$method;
- }
-
- my $id = $object->$final;
- unless (defined $id) {
- my $method = "${final}Obj";
- $id = $object->$method->Id;
- }
- return $id;
-}
-
-
-=head2 CustomFieldLookupType
-
-Returns the path RT uses to figure out which custom fields apply to this object.
-
-=cut
-
-sub CustomFieldLookupType {
- my $self = shift;
- return ref($self) || $self;
-}
-
-
-=head2 AddCustomFieldValue { Field => FIELD, Value => VALUE }
-
-VALUE should be a string. FIELD can be any identifier of a CustomField
-supported by L</LoadCustomFieldByIdentifier> method.
-
-Adds VALUE as a value of CustomField FIELD. If this is a single-value custom field,
-deletes the old value.
-If VALUE is not a valid value for the custom field, returns
-(0, 'Error message' ) otherwise, returns ($id, 'Success Message') where
-$id is ID of created L<ObjectCustomFieldValue> object.
-
-=cut
-
-sub AddCustomFieldValue {
- my $self = shift;
- $self->_AddCustomFieldValue(@_);
-}
-
-sub _AddCustomFieldValue {
- my $self = shift;
- my %args = (
- Field => undef,
- Value => undef,
- LargeContent => undef,
- ContentType => undef,
- RecordTransaction => 1,
- @_
- );
-
- my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
- unless ( $cf->Id ) {
- return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
- }
-
- my $OCFs = $self->CustomFields;
- $OCFs->Limit( FIELD => 'id', VALUE => $cf->Id );
- unless ( $OCFs->Count ) {
- return (
- 0,
- $self->loc(
- "Custom field [_1] does not apply to this object",
- ref $args{'Field'} ? $args{'Field'}->id : $args{'Field'}
- )
- );
- }
-
- # empty string is not correct value of any CF, so undef it
- foreach ( qw(Value LargeContent) ) {
- $args{ $_ } = undef if defined $args{ $_ } && !length $args{ $_ };
- }
-
- unless ( $cf->ValidateValue( $args{'Value'} ) ) {
- return ( 0, $self->loc("Invalid value for custom field") );
- }
-
- # If the custom field only accepts a certain # of values, delete the existing
- # value and record a "changed from foo to bar" transaction
- unless ( $cf->UnlimitedValues ) {
-
- # Load up a ObjectCustomFieldValues object for this custom field and this ticket
- my $values = $cf->ValuesForObject($self);
-
- # We need to whack any old values here. In most cases, the custom field should
- # only have one value to delete. In the pathalogical case, this custom field
- # used to be a multiple and we have many values to whack....
- my $cf_values = $values->Count;
-
- if ( $cf_values > $cf->MaxValues ) {
- my $i = 0; #We want to delete all but the max we can currently have , so we can then
- # execute the same code to "change" the value from old to new
- while ( my $value = $values->Next ) {
- $i++;
- if ( $i < $cf_values ) {
- my ( $val, $msg ) = $cf->DeleteValueForObject(
- Object => $self,
- Id => $value->id,
- );
- unless ($val) {
- return ( 0, $msg );
- }
- my ( $TransactionId, $Msg, $TransactionObj ) =
- $self->_NewTransaction(
- Type => 'CustomField',
- Field => $cf->Id,
- OldReference => $value,
- );
- }
- }
- $values->RedoSearch if $i; # redo search if have deleted at least one value
- }
-
- if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
- return $entry->id;
- }
-
- my $old_value = $values->First;
- my $old_content;
- $old_content = $old_value->Content if $old_value;
-
- my ( $new_value_id, $value_msg ) = $cf->AddValueForObject(
- Object => $self,
- Content => $args{'Value'},
- LargeContent => $args{'LargeContent'},
- ContentType => $args{'ContentType'},
- );
-
- unless ( $new_value_id ) {
- return ( 0, $self->loc( "Could not add new custom field value: [_1]", $value_msg ) );
- }
-
- my $new_value = RT::ObjectCustomFieldValue->new( $self->CurrentUser );
- $new_value->Load( $new_value_id );
-
- # now that adding the new value was successful, delete the old one
- if ( $old_value ) {
- my ( $val, $msg ) = $old_value->Delete();
- return ( 0, $msg ) unless $val;
- }
-
- if ( $args{'RecordTransaction'} ) {
- my ( $TransactionId, $Msg, $TransactionObj ) =
- $self->_NewTransaction(
- Type => 'CustomField',
- Field => $cf->Id,
- OldReference => $old_value,
- NewReference => $new_value,
- );
- }
-
- my $new_content = $new_value->Content;
-
- # For datetime, we need to display them in "human" format in result message
- #XXX TODO how about date without time?
- if ($cf->Type eq 'DateTime') {
- my $DateObj = RT::Date->new( $self->CurrentUser );
- $DateObj->Set(
- Format => 'ISO',
- Value => $new_content,
- );
- $new_content = $DateObj->AsString;
-
- if ( defined $old_content && length $old_content ) {
- $DateObj->Set(
- Format => 'ISO',
- Value => $old_content,
- );
- $old_content = $DateObj->AsString;
- }
- }
-
- unless ( defined $old_content && length $old_content ) {
- return ( $new_value_id, $self->loc( "[_1] [_2] added", $cf->Name, $new_content ));
- }
- elsif ( !defined $new_content || !length $new_content ) {
- return ( $new_value_id,
- $self->loc( "[_1] [_2] deleted", $cf->Name, $old_content ) );
- }
- else {
- return ( $new_value_id, $self->loc( "[_1] [_2] changed to [_3]", $cf->Name, $old_content, $new_content));
- }
-
- }
-
- # otherwise, just add a new value and record "new value added"
- else {
- if ( !$cf->Repeated ) {
- my $values = $cf->ValuesForObject($self);
- if ( my $entry = $values->HasEntry($args{'Value'}, $args{'LargeContent'}) ) {
- return $entry->id;
- }
- }
-
- my ($new_value_id, $msg) = $cf->AddValueForObject(
- Object => $self,
- Content => $args{'Value'},
- LargeContent => $args{'LargeContent'},
- ContentType => $args{'ContentType'},
- );
-
- unless ( $new_value_id ) {
- return ( 0, $self->loc( "Could not add new custom field value: [_1]", $msg ) );
- }
- if ( $args{'RecordTransaction'} ) {
- my ( $tid, $msg ) = $self->_NewTransaction(
- Type => 'CustomField',
- Field => $cf->Id,
- NewReference => $new_value_id,
- ReferenceType => 'RT::ObjectCustomFieldValue',
- );
- unless ( $tid ) {
- return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $msg ) );
- }
- }
- return ( $new_value_id, $self->loc( "[_1] added as a value for [_2]", $args{'Value'}, $cf->Name ) );
- }
-}
-
-
-
-=head2 DeleteCustomFieldValue { Field => FIELD, Value => VALUE }
-
-Deletes VALUE as a value of CustomField FIELD.
-
-VALUE can be a string, a CustomFieldValue or a ObjectCustomFieldValue.
-
-If VALUE is not a valid value for the custom field, returns
-(0, 'Error message' ) otherwise, returns (1, 'Success Message')
-
-=cut
-
-sub DeleteCustomFieldValue {
- my $self = shift;
- my %args = (
- Field => undef,
- Value => undef,
- ValueId => undef,
- @_
- );
-
- my $cf = $self->LoadCustomFieldByIdentifier($args{'Field'});
- unless ( $cf->Id ) {
- return ( 0, $self->loc( "Custom field [_1] not found", $args{'Field'} ) );
- }
-
- my ( $val, $msg ) = $cf->DeleteValueForObject(
- Object => $self,
- Id => $args{'ValueId'},
- Content => $args{'Value'},
- );
- unless ($val) {
- return ( 0, $msg );
- }
-
- my ( $TransactionId, $Msg, $TransactionObj ) = $self->_NewTransaction(
- Type => 'CustomField',
- Field => $cf->Id,
- OldReference => $val,
- ReferenceType => 'RT::ObjectCustomFieldValue',
- );
- unless ($TransactionId) {
- return ( 0, $self->loc( "Couldn't create a transaction: [_1]", $Msg ) );
- }
-
- my $old_value = $TransactionObj->OldValue;
- # For datetime, we need to display them in "human" format in result message
- if ( $cf->Type eq 'DateTime' ) {
- my $DateObj = RT::Date->new( $self->CurrentUser );
- $DateObj->Set(
- Format => 'ISO',
- Value => $old_value,
- );
- $old_value = $DateObj->AsString;
- }
- return (
- $TransactionId,
- $self->loc(
- "[_1] is no longer a value for custom field [_2]",
- $old_value, $cf->Name
- )
- );
-}
-
-
-
-=head2 FirstCustomFieldValue FIELD
-
-Return the content of the first value of CustomField FIELD for this ticket
-Takes a field id or name
-
-=cut
-
-sub FirstCustomFieldValue {
- my $self = shift;
- my $field = shift;
-
- my $values = $self->CustomFieldValues( $field );
- return undef unless my $first = $values->First;
- return $first->Content;
-}
-
-=head2 CustomFieldValuesAsString FIELD
-
-Return the content of the CustomField FIELD for this ticket.
-If this is a multi-value custom field, values will be joined with newlines.
-
-Takes a field id or name as the first argument
-
-Takes an optional Separator => "," second and third argument
-if you want to join the values using something other than a newline
-
-=cut
-
-sub CustomFieldValuesAsString {
- my $self = shift;
- my $field = shift;
- my %args = @_;
- my $separator = $args{Separator} || "\n";
-
- my $values = $self->CustomFieldValues( $field );
- return join ($separator, grep { defined $_ }
- map { $_->Content } @{$values->ItemsArrayRef});
-}
-
-
-
-=head2 CustomFieldValues FIELD
-
-Return a ObjectCustomFieldValues object of all values of the CustomField whose
-id or Name is FIELD for this record.
-
-Returns an RT::ObjectCustomFieldValues object
-
-=cut
-
-sub CustomFieldValues {
- my $self = shift;
- my $field = shift;
-
- if ( $field ) {
- my $cf = $self->LoadCustomFieldByIdentifier( $field );
-
- # we were asked to search on a custom field we couldn't find
- unless ( $cf->id ) {
- $RT::Logger->warning("Couldn't load custom field by '$field' identifier");
- return RT::ObjectCustomFieldValues->new( $self->CurrentUser );
- }
- return ( $cf->ValuesForObject($self) );
- }
-
- # we're not limiting to a specific custom field;
- my $ocfs = RT::ObjectCustomFieldValues->new( $self->CurrentUser );
- $ocfs->LimitToObject( $self );
- return $ocfs;
-}
-
-=head2 LoadCustomFieldByIdentifier IDENTIFER
-
-Find the custom field has id or name IDENTIFIER for this object.
-
-If no valid field is found, returns an empty RT::CustomField object.
-
-=cut
-
-sub LoadCustomFieldByIdentifier {
- my $self = shift;
- my $field = shift;
-
- my $cf;
- if ( UNIVERSAL::isa( $field, "RT::CustomField" ) ) {
- $cf = RT::CustomField->new($self->CurrentUser);
- $cf->SetContextObject( $self );
- $cf->LoadById( $field->id );
- }
- elsif ($field =~ /^\d+$/) {
- $cf = RT::CustomField->new($self->CurrentUser);
- $cf->SetContextObject( $self );
- $cf->LoadById($field);
- } else {
-
- my $cfs = $self->CustomFields($self->CurrentUser);
- $cfs->SetContextObject( $self );
- $cfs->Limit(FIELD => 'Name', VALUE => $field, CASESENSITIVE => 0);
- $cf = $cfs->First || RT::CustomField->new($self->CurrentUser);
- }
- return $cf;
-}
-
-sub ACLEquivalenceObjects { }
-
-sub BasicColumns { }
-
-sub WikiBase {
- return RT->Config->Get('WebPath'). "/index.html?q=";
-}
-
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-=head1 SYNOPSIS
-
- use RT::Ticket;
- my $ticket = RT::Ticket->new($CurrentUser);
- $ticket->Load($ticket_id);
-
-=head1 DESCRIPTION
-
-This module lets you manipulate RT's ticket object.
-
-
-=head1 METHODS
-
-
-=cut
-
-
-package RT::Ticket;
-
-use strict;
-use warnings;
-
-
-use RT::Queue;
-use RT::User;
-use RT::Record;
-use RT::Links;
-use RT::Date;
-use RT::CustomFields;
-use RT::Tickets;
-use RT::Transactions;
-use RT::Reminders;
-use RT::URI::fsck_com_rt;
-use RT::URI;
-use RT::URI::freeside;
-use MIME::Entity;
-use Devel::GlobalDestruction;
-
-
-# A helper table for links mapping to make it easier
-# to build and parse links between tickets
-
-our %LINKTYPEMAP = (
- MemberOf => { Type => 'MemberOf',
- Mode => 'Target', },
- Parents => { Type => 'MemberOf',
- Mode => 'Target', },
- Members => { Type => 'MemberOf',
- Mode => 'Base', },
- Children => { Type => 'MemberOf',
- Mode => 'Base', },
- HasMember => { Type => 'MemberOf',
- Mode => 'Base', },
- RefersTo => { Type => 'RefersTo',
- Mode => 'Target', },
- ReferredToBy => { Type => 'RefersTo',
- Mode => 'Base', },
- DependsOn => { Type => 'DependsOn',
- Mode => 'Target', },
- DependedOnBy => { Type => 'DependsOn',
- Mode => 'Base', },
- MergedInto => { Type => 'MergedInto',
- Mode => 'Target', },
-
-);
-
-
-# A helper table for links mapping to make it easier
-# to build and parse links between tickets
-
-our %LINKDIRMAP = (
- MemberOf => { Base => 'MemberOf',
- Target => 'HasMember', },
- RefersTo => { Base => 'RefersTo',
- Target => 'ReferredToBy', },
- DependsOn => { Base => 'DependsOn',
- Target => 'DependedOnBy', },
- MergedInto => { Base => 'MergedInto',
- Target => 'MergedInto', },
-
-);
-
-
-sub LINKTYPEMAP { return \%LINKTYPEMAP }
-sub LINKDIRMAP { return \%LINKDIRMAP }
-
-our %MERGE_CACHE = (
- effective => {},
- merged => {},
-);
-
-
-=head2 Load
-
-Takes a single argument. This can be a ticket id, ticket alias or
-local ticket uri. If the ticket can't be loaded, returns undef.
-Otherwise, returns the ticket id.
-
-=cut
-
-sub Load {
- my $self = shift;
- my $id = shift;
- $id = '' unless defined $id;
-
- # TODO: modify this routine to look at EffectiveId and
- # do the recursive load thing. be careful to cache all
- # the interim tickets we try so we don't loop forever.
-
- unless ( $id =~ /^\d+$/ ) {
- $RT::Logger->debug("Tried to load a bogus ticket id: '$id'");
- return (undef);
- }
-
- $id = $MERGE_CACHE{'effective'}{ $id }
- if $MERGE_CACHE{'effective'}{ $id };
-
- my ($ticketid, $msg) = $self->LoadById( $id );
- unless ( $self->Id ) {
- $RT::Logger->debug("$self tried to load a bogus ticket: $id");
- return (undef);
- }
-
- #If we're merged, resolve the merge.
- if ( $self->EffectiveId && $self->EffectiveId != $self->Id ) {
- $RT::Logger->debug(
- "We found a merged ticket. "
- . $self->id ."/". $self->EffectiveId
- );
- my $real_id = $self->Load( $self->EffectiveId );
- $MERGE_CACHE{'effective'}{ $id } = $real_id;
- return $real_id;
- }
-
- #Ok. we're loaded. lets get outa here.
- return $self->Id;
-}
-
-
-
-=head2 Create (ARGS)
-
-Arguments: ARGS is a hash of named parameters. Valid parameters are:
-
- id
- Queue - Either a Queue object or a Queue Name
- Requestor - A reference to a list of email addresses or RT user Names
- Cc - A reference to a list of email addresses or Names
- AdminCc - A reference to a list of email addresses or Names
- SquelchMailTo - A reference to a list of email addresses -
- who should this ticket not mail
- Type -- The ticket's type. ignore this for now
- Owner -- This ticket's owner. either an RT::User object or this user's id
- Subject -- A string describing the subject of the ticket
- Priority -- an integer from 0 to 99
- InitialPriority -- an integer from 0 to 99
- FinalPriority -- an integer from 0 to 99
- Status -- any valid status for Queue's Lifecycle, otherwises uses on_create from Lifecycle default
- TimeEstimated -- an integer. estimated time for this task in minutes
- TimeWorked -- an integer. time worked so far in minutes
- TimeLeft -- an integer. time remaining in minutes
- Starts -- an ISO date describing the ticket's start date and time in GMT
- Due -- an ISO date describing the ticket's due date and time in GMT
- MIMEObj -- a MIME::Entity object with the content of the initial ticket request.
- CustomField-<n> -- a scalar or array of values for the customfield with the id <n>
-
-Ticket links can be set up during create by passing the link type as a hask key and
-the ticket id to be linked to as a value (or a URI when linking to other objects).
-Multiple links of the same type can be created by passing an array ref. For example:
-
- Parents => 45,
- DependsOn => [ 15, 22 ],
- RefersTo => 'http://www.bestpractical.com',
-
-Supported link types are C<MemberOf>, C<HasMember>, C<RefersTo>, C<ReferredToBy>,
-C<DependsOn> and C<DependedOnBy>. Also, C<Parents> is alias for C<MemberOf> and
-C<Members> and C<Children> are aliases for C<HasMember>.
-
-Returns: TICKETID, Transaction Object, Error Message
-
-
-=cut
-
-sub Create {
- my $self = shift;
-
- my %args = (
- id => undef,
- EffectiveId => undef,
- Queue => undef,
- Requestor => undef,
- Cc => undef,
- AdminCc => undef,
- SquelchMailTo => undef,
- TransSquelchMailTo => undef,
- Type => 'ticket',
- Owner => undef,
- Subject => '',
- InitialPriority => undef,
- FinalPriority => undef,
- Priority => undef,
- Status => undef,
- TimeWorked => "0",
- TimeLeft => 0,
- TimeEstimated => 0,
- Due => undef,
- Starts => undef,
- Started => undef,
- Resolved => undef,
- WillResolve => undef,
- MIMEObj => undef,
- _RecordTransaction => 1,
- DryRun => 0,
- @_
- );
-
- my ($ErrStr, @non_fatal_errors);
-
- my $QueueObj = RT::Queue->new( RT->SystemUser );
- if ( ref $args{'Queue'} eq 'RT::Queue' ) {
- $QueueObj->Load( $args{'Queue'}->Id );
- }
- elsif ( $args{'Queue'} ) {
- $QueueObj->Load( $args{'Queue'} );
- }
- else {
- $RT::Logger->debug("'". ( $args{'Queue'} ||''). "' not a recognised queue object." );
- }
-
- #Can't create a ticket without a queue.
- unless ( $QueueObj->Id ) {
- $RT::Logger->debug("$self No queue given for ticket creation.");
- return ( 0, 0, $self->loc('Could not create ticket. Queue not set') );
- }
-
-
- #Now that we have a queue, Check the ACLS
- unless (
- $self->CurrentUser->HasRight(
- Right => 'CreateTicket',
- Object => $QueueObj
- )
- )
- {
- return (
- 0, 0,
- $self->loc( "No permission to create tickets in the queue '[_1]'", $QueueObj->Name));
- }
-
- my $cycle = $QueueObj->Lifecycle;
- unless ( defined $args{'Status'} && length $args{'Status'} ) {
- $args{'Status'} = $cycle->DefaultOnCreate;
- }
-
- $args{'Status'} = lc $args{'Status'};
- unless ( $cycle->IsValid( $args{'Status'} ) ) {
- return ( 0, 0,
- $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.",
- $self->loc($args{'Status'}))
- );
- }
-
- unless ( $cycle->IsTransition( '' => $args{'Status'} ) ) {
- return ( 0, 0,
- $self->loc("New tickets can not have status '[_1]' in this queue.",
- $self->loc($args{'Status'}))
- );
- }
-
-
-
- #Since we have a queue, we can set queue defaults
-
- #Initial Priority
- # If there's no queue default initial priority and it's not set, set it to 0
- $args{'InitialPriority'} = $QueueObj->InitialPriority || 0
- unless defined $args{'InitialPriority'};
-
- #Final priority
- # If there's no queue default final priority and it's not set, set it to 0
- $args{'FinalPriority'} = $QueueObj->FinalPriority || 0
- unless defined $args{'FinalPriority'};
-
- # Priority may have changed from InitialPriority, for the case
- # where we're importing tickets (eg, from an older RT version.)
- $args{'Priority'} = $args{'InitialPriority'}
- unless defined $args{'Priority'};
-
- # Dates
- #TODO we should see what sort of due date we're getting, rather +
- # than assuming it's in ISO format.
-
- #Set the due date. if we didn't get fed one, use the queue default due in
- my $Due = RT::Date->new( $self->CurrentUser );
- if ( defined $args{'Due'} ) {
- $Due->Set( Format => 'ISO', Value => $args{'Due'} );
- }
- elsif ( my $due_in = $QueueObj->DefaultDueIn ) {
- $Due->SetToNow;
- $Due->AddDays( $due_in );
- }
-
- my $Starts = RT::Date->new( $self->CurrentUser );
- if ( defined $args{'Starts'} ) {
- $Starts->Set( Format => 'ISO', Value => $args{'Starts'} );
- }
-
- my $Started = RT::Date->new( $self->CurrentUser );
- if ( defined $args{'Started'} ) {
- $Started->Set( Format => 'ISO', Value => $args{'Started'} );
- }
-
- my $WillResolve = RT::Date->new($self->CurrentUser );
- if ( defined $args{'WillResolve'} ) {
- $WillResolve->Set( Format => 'ISO', Value => $args{'WillResolve'} );
- }
-
- # If the status is not an initial status, set the started date
- elsif ( !$cycle->IsInitial($args{'Status'}) ) {
- $Started->SetToNow;
- }
-
- my $Resolved = RT::Date->new( $self->CurrentUser );
- if ( defined $args{'Resolved'} ) {
- $Resolved->Set( Format => 'ISO', Value => $args{'Resolved'} );
- }
-
- #If the status is an inactive status, set the resolved date
- elsif ( $cycle->IsInactive( $args{'Status'} ) )
- {
- $RT::Logger->debug( "Got a ". $args{'Status'}
- ."(inactive) ticket with undefined resolved date. Setting to now."
- );
- $Resolved->SetToNow;
- }
-
- # }}}
-
- # Dealing with time fields
-
- $args{'TimeEstimated'} = 0 unless defined $args{'TimeEstimated'};
- $args{'TimeWorked'} = 0 unless defined $args{'TimeWorked'};
- $args{'TimeLeft'} = 0 unless defined $args{'TimeLeft'};
-
- # }}}
-
- # Deal with setting the owner
-
- my $Owner;
- if ( ref( $args{'Owner'} ) eq 'RT::User' ) {
- if ( $args{'Owner'}->id ) {
- $Owner = $args{'Owner'};
- } else {
- $RT::Logger->error('Passed an empty RT::User for owner');
- push @non_fatal_errors,
- $self->loc("Owner could not be set.") . " ".
- $self->loc("Invalid value for [_1]",loc('owner'));
- $Owner = undef;
- }
- }
-
- #If we've been handed something else, try to load the user.
- elsif ( $args{'Owner'} ) {
- $Owner = RT::User->new( $self->CurrentUser );
- $Owner->Load( $args{'Owner'} );
- if (!$Owner->id) {
- $Owner->LoadByEmail( $args{'Owner'} )
- }
- unless ( $Owner->Id ) {
- push @non_fatal_errors,
- $self->loc("Owner could not be set.") . " "
- . $self->loc( "User '[_1]' could not be found.", $args{'Owner'} );
- $Owner = undef;
- }
- }
-
- #If we have a proposed owner and they don't have the right
- #to own a ticket, scream about it and make them not the owner
-
- my $DeferOwner;
- if ( $Owner && $Owner->Id != RT->Nobody->Id
- && !$Owner->HasRight( Object => $QueueObj, Right => 'OwnTicket' ) )
- {
- $DeferOwner = $Owner;
- $Owner = undef;
- $RT::Logger->debug('going to deffer setting owner');
-
- }
-
- #If we haven't been handed a valid owner, make it nobody.
- unless ( defined($Owner) && $Owner->Id ) {
- $Owner = RT::User->new( $self->CurrentUser );
- $Owner->Load( RT->Nobody->Id );
- }
-
- # }}}
-
-# We attempt to load or create each of the people who might have a role for this ticket
-# _outside_ the transaction, so we don't get into ticket creation races
- foreach my $type ( "Cc", "AdminCc", "Requestor" ) {
- $args{ $type } = [ $args{ $type } ] unless ref $args{ $type };
- foreach my $watcher ( splice @{ $args{$type} } ) {
- next unless $watcher;
- if ( $watcher =~ /^\d+$/ ) {
- push @{ $args{$type} }, $watcher;
- } else {
- my @addresses = RT::EmailParser->ParseEmailAddress( $watcher );
- foreach my $address( @addresses ) {
- my $user = RT::User->new( RT->SystemUser );
- my ($uid, $msg) = $user->LoadOrCreateByEmail( $address );
- unless ( $uid ) {
- push @non_fatal_errors,
- $self->loc("Couldn't load or create user: [_1]", $msg);
- } else {
- push @{ $args{$type} }, $user->id;
- }
- }
- }
- }
- }
-
- $args{'Type'} = lc $args{'Type'}
- if $args{'Type'} =~ /^(ticket|approval|reminder)$/i;
-
- $args{'Subject'} =~ s/\n//g;
-
- $RT::Handle->BeginTransaction();
-
- my %params = (
- Queue => $QueueObj->Id,
- Owner => $Owner->Id,
- Subject => $args{'Subject'},
- InitialPriority => $args{'InitialPriority'},
- FinalPriority => $args{'FinalPriority'},
- Priority => $args{'Priority'},
- Status => $args{'Status'},
- TimeWorked => $args{'TimeWorked'},
- TimeEstimated => $args{'TimeEstimated'},
- TimeLeft => $args{'TimeLeft'},
- Type => $args{'Type'},
- Starts => $Starts->ISO,
- Started => $Started->ISO,
- Resolved => $Resolved->ISO,
- WillResolve => $WillResolve->ISO,
- Due => $Due->ISO
- );
-
-# Parameters passed in during an import that we probably don't want to touch, otherwise
- foreach my $attr (qw(id Creator Created LastUpdated LastUpdatedBy)) {
- $params{$attr} = $args{$attr} if $args{$attr};
- }
-
- # Delete null integer parameters
- foreach my $attr
- (qw(TimeWorked TimeLeft TimeEstimated InitialPriority FinalPriority))
- {
- delete $params{$attr}
- unless ( exists $params{$attr} && $params{$attr} );
- }
-
- # Delete the time worked if we're counting it in the transaction
- delete $params{'TimeWorked'} if $args{'_RecordTransaction'};
-
- my ($id,$ticket_message) = $self->SUPER::Create( %params );
- unless ($id) {
- $RT::Logger->crit( "Couldn't create a ticket: " . $ticket_message );
- $RT::Handle->Rollback();
- return ( 0, 0,
- $self->loc("Ticket could not be created due to an internal error")
- );
- }
-
- #Set the ticket's effective ID now that we've created it.
- my ( $val, $msg ) = $self->__Set(
- Field => 'EffectiveId',
- Value => ( $args{'EffectiveId'} || $id )
- );
- unless ( $val ) {
- $RT::Logger->crit("Couldn't set EffectiveId: $msg");
- $RT::Handle->Rollback;
- return ( 0, 0,
- $self->loc("Ticket could not be created due to an internal error")
- );
- }
-
- my $create_groups_ret = $self->_CreateTicketGroups();
- unless ($create_groups_ret) {
- $RT::Logger->crit( "Couldn't create ticket groups for ticket "
- . $self->Id
- . ". aborting Ticket creation." );
- $RT::Handle->Rollback();
- return ( 0, 0,
- $self->loc("Ticket could not be created due to an internal error")
- );
- }
-
- # Set the owner in the Groups table
- # We denormalize it into the Ticket table too because doing otherwise would
- # kill performance, bigtime. It gets kept in lockstep thanks to the magic of transactionalization
- $self->OwnerGroup->_AddMember(
- PrincipalId => $Owner->PrincipalId,
- InsideTransaction => 1
- ) unless $DeferOwner;
-
-
-
- # Deal with setting up watchers
-
- foreach my $type ( "Cc", "AdminCc", "Requestor" ) {
- # we know it's an array ref
- foreach my $watcher ( @{ $args{$type} } ) {
-
- # Note that we're using AddWatcher, rather than _AddWatcher, as we
- # actually _want_ that ACL check. Otherwise, random ticket creators
- # could make themselves adminccs and maybe get ticket rights. that would
- # be poor
- my $method = $type eq 'AdminCc'? 'AddWatcher': '_AddWatcher';
-
- my ($val, $msg) = $self->$method(
- Type => $type,
- PrincipalId => $watcher,
- Silent => 1,
- );
- push @non_fatal_errors, $self->loc("Couldn't set [_1] watcher: [_2]", $type, $msg)
- unless $val;
- }
- }
-
- if ($args{'SquelchMailTo'}) {
- my @squelch = ref( $args{'SquelchMailTo'} ) ? @{ $args{'SquelchMailTo'} }
- : $args{'SquelchMailTo'};
- $self->_SquelchMailTo( @squelch );
- }
-
-
- # }}}
-
- # Add all the custom fields
-
- foreach my $arg ( keys %args ) {
- next unless $arg =~ /^CustomField-(\d+)$/i;
- my $cfid = $1;
-
- foreach my $value (
- UNIVERSAL::isa( $args{$arg} => 'ARRAY' ) ? @{ $args{$arg} } : ( $args{$arg} ) )
- {
- next unless defined $value && length $value;
-
- # Allow passing in uploaded LargeContent etc by hash reference
- my ($status, $msg) = $self->_AddCustomFieldValue(
- (UNIVERSAL::isa( $value => 'HASH' )
- ? %$value
- : (Value => $value)
- ),
- Field => $cfid,
- RecordTransaction => 0,
- );
- push @non_fatal_errors, $msg unless $status;
- }
- }
-
- # }}}
-
- # Deal with setting up links
-
- # TODO: Adding link may fire scrips on other end and those scrips
- # could create transactions on this ticket before 'Create' transaction.
- #
- # We should implement different lifecycle: record 'Create' transaction,
- # create links and only then fire create transaction's scrips.
- #
- # Ideal variant: add all links without firing scrips, record create
- # transaction and only then fire scrips on the other ends of links.
- #
- # //RUZ
-
- foreach my $type ( keys %LINKTYPEMAP ) {
- next unless ( defined $args{$type} );
- foreach my $link (
- ref( $args{$type} ) ? @{ $args{$type} } : ( $args{$type} ) )
- {
- my ( $val, $msg, $obj ) = $self->__GetTicketFromURI( URI => $link );
- unless ($val) {
- push @non_fatal_errors, $msg;
- next;
- }
-
- # Check rights on the other end of the link if we must
- # then run _AddLink that doesn't check for ACLs
- if ( RT->Config->Get( 'StrictLinkACL' ) ) {
- if ( $obj && !$obj->CurrentUserHasRight('ModifyTicket') ) {
- push @non_fatal_errors, $self->loc('Linking. Permission denied');
- next;
- }
- }
-
- if ( $obj && lc $obj->Status eq 'deleted' ) {
- push @non_fatal_errors,
- $self->loc("Linking. Can't link to a deleted ticket");
- next;
- }
-
- my ( $wval, $wmsg ) = $self->_AddLink(
- Type => $LINKTYPEMAP{$type}->{'Type'},
- $LINKTYPEMAP{$type}->{'Mode'} => $link,
- Silent => !$args{'_RecordTransaction'} || $self->Type eq 'reminder',
- 'Silent'. ( $LINKTYPEMAP{$type}->{'Mode'} eq 'Base'? 'Target': 'Base' )
- => 1,
- );
-
- push @non_fatal_errors, $wmsg unless ($wval);
- }
- }
-
- # }}}
-
- # {{{ Deal with auto-customer association
-
- #unless we already have (a) customer(s)...
- unless ( $self->Customers->Count ) {
-
- #first find any requestors with emails but *without* customer targets
- my @NoCust_Requestors =
- grep { $_->EmailAddress && ! $_->Customers->Count }
- @{ $self->_Requestors->UserMembersObj->ItemsArrayRef };
-
- for my $Requestor (@NoCust_Requestors) {
-
- #perhaps the stuff in here should be in a User method??
- my @Customers =
- &RT::URI::freeside::email_search( email=>$Requestor->EmailAddress );
-
- foreach my $custnum ( map $_->{'custnum'}, @Customers ) {
-
- ## false laziness w/RT/Interface/Web_Vendor.pm
- my @link = ( 'Type' => 'MemberOf',
- 'Target' => "freeside://freeside/cust_main/$custnum",
- );
-
- my( $val, $msg ) = $Requestor->_AddLink(@link);
- #XXX should do something with $msg# push @non_fatal_errors, $msg;
-
- }
-
- }
-
- #find any requestors with customer targets
-
- my %cust_target = ();
-
- my @Requestors =
- grep { $_->Customers->Count }
- @{ $self->_Requestors->UserMembersObj->ItemsArrayRef };
-
- foreach my $Requestor ( @Requestors ) {
- foreach my $cust_link ( @{ $Requestor->Customers->ItemsArrayRef } ) {
- $cust_target{ $cust_link->Target } = 1;
- }
- }
-
- #and then auto-associate this ticket with those customers
-
- foreach my $cust_target ( keys %cust_target ) {
-
- my @link = ( 'Type' => 'MemberOf',
- #'Target' => "freeside://freeside/cust_main/$custnum",
- 'Target' => $cust_target,
- );
-
- my( $val, $msg ) = $self->_AddLink(@link);
- push @non_fatal_errors, $msg;
-
- }
-
- }
-
- # }}}
-
- # Now that we've created the ticket and set up its metadata, we can actually go and check OwnTicket on the ticket itself.
- # This might be different than before in cases where extensions like RTIR are doing clever things with RT's ACL system
- if ( $DeferOwner ) {
- if (!$DeferOwner->HasRight( Object => $self, Right => 'OwnTicket')) {
-
- $RT::Logger->warning( "User " . $DeferOwner->Name . "(" . $DeferOwner->id
- . ") was proposed as a ticket owner but has no rights to own "
- . "tickets in " . $QueueObj->Name );
- push @non_fatal_errors, $self->loc(
- "Owner '[_1]' does not have rights to own this ticket.",
- $DeferOwner->Name
- );
- } else {
- $Owner = $DeferOwner;
- $self->__Set(Field => 'Owner', Value => $Owner->id);
-
- }
- $self->OwnerGroup->_AddMember(
- PrincipalId => $Owner->PrincipalId,
- InsideTransaction => 1
- );
- }
-
- #don't make a transaction or fire off any scrips for reminders either
- if ( $args{'_RecordTransaction'} && $self->Type ne 'reminder' ) {
-
- # Add a transaction for the create
- my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
- Type => "Create",
- TimeTaken => $args{'TimeWorked'},
- MIMEObj => $args{'MIMEObj'},
- CommitScrips => !$args{'DryRun'},
- SquelchMailTo => $args{'TransSquelchMailTo'},
- );
-
- if ( $self->Id && $Trans ) {
-
- #$TransObj->UpdateCustomFields(ARGSRef => \%args);
- $TransObj->UpdateCustomFields(%args);
-
- $RT::Logger->info( "Ticket " . $self->Id . " created in queue '" . $QueueObj->Name . "' by " . $self->CurrentUser->Name );
- $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name );
- $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
- }
- else {
- $RT::Handle->Rollback();
-
- $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
- $RT::Logger->error("Ticket couldn't be created: $ErrStr");
- return ( 0, 0, $self->loc( "Ticket could not be created due to an internal error"));
- }
-
- if ( $args{'DryRun'} ) {
- $RT::Handle->Rollback();
- return ($self->id, $TransObj, $ErrStr);
- }
- $RT::Handle->Commit();
- return ( $self->Id, $TransObj->Id, $ErrStr );
-
- # }}}
- }
- else {
-
- # Not going to record a transaction
- $RT::Handle->Commit();
- $ErrStr = $self->loc( "Ticket [_1] created in queue '[_2]'", $self->Id, $QueueObj->Name );
- $ErrStr = join( "\n", $ErrStr, @non_fatal_errors );
- return ( $self->Id, 0, $ErrStr );
-
- }
-}
-
-sub SetType {
- my $self = shift;
- my $value = shift;
-
- # Force lowercase on internal RT types
- $value = lc $value
- if $value =~ /^(ticket|approval|reminder)$/i;
- return $self->_Set(Field => 'Type', Value => $value, @_);
-}
-
-
-
-=head2 _Parse822HeadersForAttributes Content
-
-Takes an RFC822 style message and parses its attributes into a hash.
-
-=cut
-
-sub _Parse822HeadersForAttributes {
- my $self = shift;
- my $content = shift;
- my %args;
-
- my @lines = ( split ( /\n/, $content ) );
- while ( defined( my $line = shift @lines ) ) {
- if ( $line =~ /^(.*?):(?:\s+(.*))?$/ ) {
- my $value = $2;
- my $tag = lc($1);
-
- $tag =~ s/-//g;
- if ( defined( $args{$tag} ) )
- { #if we're about to get a second value, make it an array
- $args{$tag} = [ $args{$tag} ];
- }
- if ( ref( $args{$tag} ) )
- { #If it's an array, we want to push the value
- push @{ $args{$tag} }, $value;
- }
- else { #if there's nothing there, just set the value
- $args{$tag} = $value;
- }
- } elsif ($line =~ /^$/) {
-
- #TODO: this won't work, since "" isn't of the form "foo:value"
-
- while ( defined( my $l = shift @lines ) ) {
- push @{ $args{'content'} }, $l;
- }
- }
-
- }
-
- foreach my $date (qw(due starts started resolved)) {
- my $dateobj = RT::Date->new(RT->SystemUser);
- if ( defined ($args{$date}) and $args{$date} =~ /^\d+$/ ) {
- $dateobj->Set( Format => 'unix', Value => $args{$date} );
- }
- else {
- $dateobj->Set( Format => 'unknown', Value => $args{$date} );
- }
- $args{$date} = $dateobj->ISO;
- }
- $args{'mimeobj'} = MIME::Entity->new();
- $args{'mimeobj'}->build(
- Type => ( $args{'contenttype'} || 'text/plain' ),
- Data => ($args{'content'} || '')
- );
-
- return (%args);
-}
-
-
-
-=head2 Import PARAMHASH
-
-Import a ticket.
-Doesn't create a transaction.
-Doesn't supply queue defaults, etc.
-
-Returns: TICKETID
-
-=cut
-
-sub Import {
- my $self = shift;
- my ( $ErrStr, $QueueObj, $Owner );
-
- my %args = (
- id => undef,
- EffectiveId => undef,
- Queue => undef,
- Requestor => undef,
- Type => 'ticket',
- Owner => RT->Nobody->Id,
- Subject => '[no subject]',
- InitialPriority => undef,
- FinalPriority => undef,
- Status => 'new',
- TimeWorked => "0",
- Due => undef,
- Created => undef,
- Updated => undef,
- Resolved => undef,
- Told => undef,
- @_
- );
-
- if ( ( defined( $args{'Queue'} ) ) && ( !ref( $args{'Queue'} ) ) ) {
- $QueueObj = RT::Queue->new(RT->SystemUser);
- $QueueObj->Load( $args{'Queue'} );
-
- #TODO error check this and return 0 if it's not loading properly +++
- }
- elsif ( ref( $args{'Queue'} ) eq 'RT::Queue' ) {
- $QueueObj = RT::Queue->new(RT->SystemUser);
- $QueueObj->Load( $args{'Queue'}->Id );
- }
- else {
- $RT::Logger->debug(
- "$self " . $args{'Queue'} . " not a recognised queue object." );
- }
-
- #Can't create a ticket without a queue.
- unless ( defined($QueueObj) and $QueueObj->Id ) {
- $RT::Logger->debug("$self No queue given for ticket creation.");
- return ( 0, $self->loc('Could not create ticket. Queue not set') );
- }
-
- #Now that we have a queue, Check the ACLS
- unless (
- $self->CurrentUser->HasRight(
- Right => 'CreateTicket',
- Object => $QueueObj
- )
- )
- {
- return ( 0,
- $self->loc("No permission to create tickets in the queue '[_1]'"
- , $QueueObj->Name));
- }
-
- # Deal with setting the owner
-
- # Attempt to take user object, user name or user id.
- # Assign to nobody if lookup fails.
- if ( defined( $args{'Owner'} ) ) {
- if ( ref( $args{'Owner'} ) ) {
- $Owner = $args{'Owner'};
- }
- else {
- $Owner = RT::User->new( $self->CurrentUser );
- $Owner->Load( $args{'Owner'} );
- if ( !defined( $Owner->id ) ) {
- $Owner->Load( RT->Nobody->id );
- }
- }
- }
-
- #If we have a proposed owner and they don't have the right
- #to own a ticket, scream about it and make them not the owner
- if (
- ( defined($Owner) )
- and ( $Owner->Id != RT->Nobody->Id )
- and (
- !$Owner->HasRight(
- Object => $QueueObj,
- Right => 'OwnTicket'
- )
- )
- )
- {
-
- $RT::Logger->warning( "$self user "
- . $Owner->Name . "("
- . $Owner->id
- . ") was proposed "
- . "as a ticket owner but has no rights to own "
- . "tickets in '"
- . $QueueObj->Name . "'" );
-
- $Owner = undef;
- }
-
- #If we haven't been handed a valid owner, make it nobody.
- unless ( defined($Owner) ) {
- $Owner = RT::User->new( $self->CurrentUser );
- $Owner->Load( RT->Nobody->UserObj->Id );
- }
-
- # }}}
-
- unless ( $self->ValidateStatus( $args{'Status'} ) ) {
- return ( 0, $self->loc("'[_1]' is an invalid value for status", $args{'Status'}) );
- }
-
- $self->{'_AccessibleCache'}{Created} = { 'read' => 1, 'write' => 1 };
- $self->{'_AccessibleCache'}{Creator} = { 'read' => 1, 'auto' => 1 };
- $self->{'_AccessibleCache'}{LastUpdated} = { 'read' => 1, 'write' => 1 };
- $self->{'_AccessibleCache'}{LastUpdatedBy} = { 'read' => 1, 'auto' => 1 };
-
- # If we're coming in with an id, set that now.
- my $EffectiveId = undef;
- if ( $args{'id'} ) {
- $EffectiveId = $args{'id'};
-
- }
-
- my $id = $self->SUPER::Create(
- id => $args{'id'},
- EffectiveId => $EffectiveId,
- Queue => $QueueObj->Id,
- Owner => $Owner->Id,
- Subject => $args{'Subject'}, # loc
- InitialPriority => $args{'InitialPriority'}, # loc
- FinalPriority => $args{'FinalPriority'}, # loc
- Priority => $args{'InitialPriority'}, # loc
- Status => $args{'Status'}, # loc
- TimeWorked => $args{'TimeWorked'}, # loc
- Type => $args{'Type'}, # loc
- Created => $args{'Created'}, # loc
- Told => $args{'Told'}, # loc
- LastUpdated => $args{'Updated'}, # loc
- Resolved => $args{'Resolved'}, # loc
- Due => $args{'Due'}, # loc
- );
-
- # If the ticket didn't have an id
- # Set the ticket's effective ID now that we've created it.
- if ( $args{'id'} ) {
- $self->Load( $args{'id'} );
- }
- else {
- my ( $val, $msg ) =
- $self->__Set( Field => 'EffectiveId', Value => $id );
-
- unless ($val) {
- $RT::Logger->err(
- $self . "->Import couldn't set EffectiveId: $msg" );
- }
- }
-
- my $create_groups_ret = $self->_CreateTicketGroups();
- unless ($create_groups_ret) {
- $RT::Logger->crit(
- "Couldn't create ticket groups for ticket " . $self->Id );
- }
-
- $self->OwnerGroup->_AddMember( PrincipalId => $Owner->PrincipalId );
-
- foreach my $watcher ( @{ $args{'Cc'} } ) {
- $self->_AddWatcher( Type => 'Cc', Email => $watcher, Silent => 1 );
- }
- foreach my $watcher ( @{ $args{'AdminCc'} } ) {
- $self->_AddWatcher( Type => 'AdminCc', Email => $watcher,
- Silent => 1 );
- }
- foreach my $watcher ( @{ $args{'Requestor'} } ) {
- $self->_AddWatcher( Type => 'Requestor', Email => $watcher,
- Silent => 1 );
- }
-
- return ( $self->Id, $ErrStr );
-}
-
-
-
-
-=head2 _CreateTicketGroups
-
-Create the ticket groups and links for this ticket.
-This routine expects to be called from Ticket->Create _inside of a transaction_
-
-It will create four groups for this ticket: Requestor, Cc, AdminCc and Owner.
-
-It will return true on success and undef on failure.
-
-
-=cut
-
-
-sub _CreateTicketGroups {
- my $self = shift;
-
- my @types = (qw(Requestor Owner Cc AdminCc));
-
- foreach my $type (@types) {
- my $type_obj = RT::Group->new($self->CurrentUser);
- my ($id, $msg) = $type_obj->CreateRoleGroup(Domain => 'RT::Ticket-Role',
- Instance => $self->Id,
- Type => $type);
- unless ($id) {
- $RT::Logger->error("Couldn't create a ticket group of type '$type' for ticket ".
- $self->Id.": ".$msg);
- return(undef);
- }
- }
- return(1);
-
-}
-
-
-
-=head2 OwnerGroup
-
-A constructor which returns an RT::Group object containing the owner of this ticket.
-
-=cut
-
-sub OwnerGroup {
- my $self = shift;
- my $owner_obj = RT::Group->new($self->CurrentUser);
- $owner_obj->LoadTicketRoleGroup( Ticket => $self->Id, Type => 'Owner');
- return ($owner_obj);
-}
-
-
-
-
-=head2 AddWatcher
-
-AddWatcher takes a parameter hash. The keys are as follows:
-
-Type One of Requestor, Cc, AdminCc
-
-PrincipalId The RT::Principal id of the user or group that's being added as a watcher
-
-Email The email address of the new watcher. If a user with this
- email address can't be found, a new nonprivileged user will be created.
-
-If the watcher you're trying to set has an RT account, set the PrincipalId paremeter to their User Id. Otherwise, set the Email parameter to their Email address.
-
-=cut
-
-sub AddWatcher {
- my $self = shift;
- my %args = (
- Type => undef,
- PrincipalId => undef,
- Email => undef,
- @_
- );
-
- # ModifyTicket works in any case
- return $self->_AddWatcher( %args )
- if $self->CurrentUserHasRight('ModifyTicket');
- if ( $args{'Email'} ) {
- my ($addr) = RT::EmailParser->ParseEmailAddress( $args{'Email'} );
- return (0, $self->loc("Couldn't parse address from '[_1]' string", $args{'Email'} ))
- unless $addr;
-
- if ( lc $self->CurrentUser->EmailAddress
- eq lc RT::User->CanonicalizeEmailAddress( $addr->address ) )
- {
- $args{'PrincipalId'} = $self->CurrentUser->id;
- delete $args{'Email'};
- }
- }
-
- # If the watcher isn't the current user then the current user has no right
- # bail
- unless ( $args{'PrincipalId'} && $self->CurrentUser->id == $args{'PrincipalId'} ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- # If it's an AdminCc and they don't have 'WatchAsAdminCc', bail
- if ( $args{'Type'} eq 'AdminCc' ) {
- unless ( $self->CurrentUserHasRight('WatchAsAdminCc') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- }
-
- # If it's a Requestor or Cc and they don't have 'Watch', bail
- elsif ( $args{'Type'} eq 'Cc' || $args{'Type'} eq 'Requestor' ) {
- unless ( $self->CurrentUserHasRight('Watch') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- }
- else {
- $RT::Logger->warning( "AddWatcher got passed a bogus type");
- return ( 0, $self->loc('Error in parameters to Ticket->AddWatcher') );
- }
-
- return $self->_AddWatcher( %args );
-}
-
-#This contains the meat of AddWatcher. but can be called from a routine like
-# Create, which doesn't need the additional acl check
-sub _AddWatcher {
- my $self = shift;
- my %args = (
- Type => undef,
- Silent => undef,
- PrincipalId => undef,
- Email => undef,
- @_
- );
-
-
- my $principal = RT::Principal->new($self->CurrentUser);
- if ($args{'Email'}) {
- if ( RT::EmailParser->IsRTAddress( $args{'Email'} ) ) {
- return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $args{'Email'}, $self->loc($args{'Type'})));
- }
- my $user = RT::User->new(RT->SystemUser);
- my ($pid, $msg) = $user->LoadOrCreateByEmail( $args{'Email'} );
- $args{'PrincipalId'} = $pid if $pid;
- }
- if ($args{'PrincipalId'}) {
- $principal->Load($args{'PrincipalId'});
- if ( $principal->id and $principal->IsUser and my $email = $principal->Object->EmailAddress ) {
- return (0, $self->loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email, $self->loc($args{'Type'})))
- if RT::EmailParser->IsRTAddress( $email );
-
- }
- }
-
-
- # If we can't find this watcher, we need to bail.
- unless ($principal->Id) {
- $RT::Logger->error("Could not load create a user with the email address '".$args{'Email'}. "' to add as a watcher for ticket ".$self->Id);
- return(0, $self->loc("Could not find or create that user"));
- }
-
-
- my $group = RT::Group->new($self->CurrentUser);
- $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->Id);
- unless ($group->id) {
- return(0,$self->loc("Group not found"));
- }
-
- if ( $group->HasMember( $principal)) {
-
- return ( 0, $self->loc('[_1] is already a [_2] for this ticket',
- $principal->Object->Name, $self->loc($args{'Type'})) );
- }
-
-
- my ( $m_id, $m_msg ) = $group->_AddMember( PrincipalId => $principal->Id,
- InsideTransaction => 1 );
- unless ($m_id) {
- $RT::Logger->error("Failed to add ".$principal->Id." as a member of group ".$group->Id.": ".$m_msg);
-
- return ( 0, $self->loc('Could not make [_1] a [_2] for this ticket',
- $principal->Object->Name, $self->loc($args{'Type'})) );
- }
-
- unless ( $args{'Silent'} ) {
- $self->_NewTransaction(
- Type => 'AddWatcher',
- NewValue => $principal->Id,
- Field => $args{'Type'}
- );
- }
-
- return ( 1, $self->loc('Added [_1] as a [_2] for this ticket',
- $principal->Object->Name, $self->loc($args{'Type'})) );
-}
-
-
-
-
-=head2 DeleteWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL_ADDRESS }
-
-
-Deletes a Ticket watcher. Takes two arguments:
-
-Type (one of Requestor,Cc,AdminCc)
-
-and one of
-
-PrincipalId (an RT::Principal Id of the watcher you want to remove)
- OR
-Email (the email address of an existing wathcer)
-
-
-=cut
-
-
-sub DeleteWatcher {
- my $self = shift;
-
- my %args = ( Type => undef,
- PrincipalId => undef,
- Email => undef,
- @_ );
-
- unless ( $args{'PrincipalId'} || $args{'Email'} ) {
- return ( 0, $self->loc("No principal specified") );
- }
- my $principal = RT::Principal->new( $self->CurrentUser );
- if ( $args{'PrincipalId'} ) {
-
- $principal->Load( $args{'PrincipalId'} );
- }
- else {
- my $user = RT::User->new( $self->CurrentUser );
- $user->LoadByEmail( $args{'Email'} );
- $principal->Load( $user->Id );
- }
-
- # If we can't find this watcher, we need to bail.
- unless ( $principal->Id ) {
- return ( 0, $self->loc("Could not find that principal") );
- }
-
- my $group = RT::Group->new( $self->CurrentUser );
- $group->LoadTicketRoleGroup( Type => $args{'Type'}, Ticket => $self->Id );
- unless ( $group->id ) {
- return ( 0, $self->loc("Group not found") );
- }
-
- # Check ACLS
- #If the watcher we're trying to add is for the current user
- if ( $self->CurrentUser->PrincipalId == $principal->id ) {
-
- # If it's an AdminCc and they don't have
- # 'WatchAsAdminCc' or 'ModifyTicket', bail
- if ( $args{'Type'} eq 'AdminCc' ) {
- unless ( $self->CurrentUserHasRight('ModifyTicket')
- or $self->CurrentUserHasRight('WatchAsAdminCc') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- }
-
- # If it's a Requestor or Cc and they don't have
- # 'Watch' or 'ModifyTicket', bail
- elsif ( ( $args{'Type'} eq 'Cc' ) or ( $args{'Type'} eq 'Requestor' ) )
- {
- unless ( $self->CurrentUserHasRight('ModifyTicket')
- or $self->CurrentUserHasRight('Watch') ) {
- return ( 0, $self->loc('Permission Denied') );
- }
- }
- else {
- $RT::Logger->warning("$self -> DeleteWatcher got passed a bogus type");
- return ( 0,
- $self->loc('Error in parameters to Ticket->DeleteWatcher') );
- }
- }
-
- # If the watcher isn't the current user
- # and the current user doesn't have 'ModifyTicket' bail
- else {
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
- }
-
- # }}}
-
- # see if this user is already a watcher.
-
- unless ( $group->HasMember($principal) ) {
- return ( 0,
- $self->loc( '[_1] is not a [_2] for this ticket',
- $principal->Object->Name, $args{'Type'} ) );
- }
-
- my ( $m_id, $m_msg ) = $group->_DeleteMember( $principal->Id );
- unless ($m_id) {
- $RT::Logger->error( "Failed to delete "
- . $principal->Id
- . " as a member of group "
- . $group->Id . ": "
- . $m_msg );
-
- return (0,
- $self->loc(
- 'Could not remove [_1] as a [_2] for this ticket',
- $principal->Object->Name, $args{'Type'} ) );
- }
-
- unless ( $args{'Silent'} ) {
- $self->_NewTransaction( Type => 'DelWatcher',
- OldValue => $principal->Id,
- Field => $args{'Type'} );
- }
-
- return ( 1,
- $self->loc( "[_1] is no longer a [_2] for this ticket.",
- $principal->Object->Name,
- $args{'Type'} ) );
-}
-
-
-
-
-
-=head2 SquelchMailTo [EMAIL]
-
-Takes an optional email address to never email about updates to this ticket.
-
-
-Returns an array of the RT::Attribute objects for this ticket's 'SquelchMailTo' attributes.
-
-
-=cut
-
-sub SquelchMailTo {
- my $self = shift;
- if (@_) {
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ();
- }
- } else {
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- return ();
- }
-
- }
- return $self->_SquelchMailTo(@_);
-}
-
-sub _SquelchMailTo {
- my $self = shift;
- if (@_) {
- my $attr = shift;
- $self->AddAttribute( Name => 'SquelchMailTo', Content => $attr )
- unless grep { $_->Content eq $attr }
- $self->Attributes->Named('SquelchMailTo');
- }
- my @attributes = $self->Attributes->Named('SquelchMailTo');
- return (@attributes);
-}
-
-
-=head2 UnsquelchMailTo ADDRESS
-
-Takes an address and removes it from this ticket's "SquelchMailTo" list. If an address appears multiple times, each instance is removed.
-
-Returns a tuple of (status, message)
-
-=cut
-
-sub UnsquelchMailTo {
- my $self = shift;
-
- my $address = shift;
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- my ($val, $msg) = $self->Attributes->DeleteEntry ( Name => 'SquelchMailTo', Content => $address);
- return ($val, $msg);
-}
-
-
-
-=head2 RequestorAddresses
-
-B<Returns> String: All Ticket Requestor email addresses as a string.
-
-=cut
-
-sub RequestorAddresses {
- my $self = shift;
-
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- return undef;
- }
-
- return ( $self->Requestors->MemberEmailAddressesAsString );
-}
-
-
-=head2 AdminCcAddresses
-
-returns String: All Ticket AdminCc email addresses as a string
-
-=cut
-
-sub AdminCcAddresses {
- my $self = shift;
-
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- return undef;
- }
-
- return ( $self->AdminCc->MemberEmailAddressesAsString )
-
-}
-
-=head2 CcAddresses
-
-returns String: All Ticket Ccs as a string of email addresses
-
-=cut
-
-sub CcAddresses {
- my $self = shift;
-
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- return undef;
- }
- return ( $self->Cc->MemberEmailAddressesAsString);
-
-}
-
-
-
-
-=head2 Requestors
-
-Takes nothing.
-Returns this ticket's Requestors as an RT::Group object
-
-=cut
-
-sub Requestors {
- my $self = shift;
-
- my $group = RT::Group->new($self->CurrentUser);
- if ( $self->CurrentUserHasRight('ShowTicket') ) {
- $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id);
- }
- return ($group);
-
-}
-
-=head2 _Requestors
-
-Private non-ACLed variant of Reqeustors so that we can look them up for the
-purposes of customer auto-association during create.
-
-=cut
-
-sub _Requestors {
- my $self = shift;
-
- my $group = RT::Group->new($RT::SystemUser);
- $group->LoadTicketRoleGroup(Type => 'Requestor', Ticket => $self->Id);
- return ($group);
-}
-
-=head2 Cc
-
-Takes nothing.
-Returns an RT::Group object which contains this ticket's Ccs.
-If the user doesn't have "ShowTicket" permission, returns an empty group
-
-=cut
-
-sub Cc {
- my $self = shift;
-
- my $group = RT::Group->new($self->CurrentUser);
- if ( $self->CurrentUserHasRight('ShowTicket') ) {
- $group->LoadTicketRoleGroup(Type => 'Cc', Ticket => $self->Id);
- }
- return ($group);
-
-}
-
-
-
-=head2 AdminCc
-
-Takes nothing.
-Returns an RT::Group object which contains this ticket's AdminCcs.
-If the user doesn't have "ShowTicket" permission, returns an empty group
-
-=cut
-
-sub AdminCc {
- my $self = shift;
-
- my $group = RT::Group->new($self->CurrentUser);
- if ( $self->CurrentUserHasRight('ShowTicket') ) {
- $group->LoadTicketRoleGroup(Type => 'AdminCc', Ticket => $self->Id);
- }
- return ($group);
-
-}
-
-
-
-
-# a generic routine to be called by IsRequestor, IsCc and IsAdminCc
-
-=head2 IsWatcher { Type => TYPE, PrincipalId => PRINCIPAL_ID, Email => EMAIL }
-
-Takes a param hash with the attributes Type and either PrincipalId or Email
-
-Type is one of Requestor, Cc, AdminCc and Owner
-
-PrincipalId is an RT::Principal id, and Email is an email address.
-
-Returns true if the specified principal (or the one corresponding to the
-specified address) is a member of the group Type for this ticket.
-
-XX TODO: This should be Memoized.
-
-=cut
-
-sub IsWatcher {
- my $self = shift;
-
- my %args = ( Type => 'Requestor',
- PrincipalId => undef,
- Email => undef,
- @_
- );
-
- # Load the relevant group.
- my $group = RT::Group->new($self->CurrentUser);
- $group->LoadTicketRoleGroup(Type => $args{'Type'}, Ticket => $self->id);
-
- # Find the relevant principal.
- if (!$args{PrincipalId} && $args{Email}) {
- # Look up the specified user.
- my $user = RT::User->new($self->CurrentUser);
- $user->LoadByEmail($args{Email});
- if ($user->Id) {
- $args{PrincipalId} = $user->PrincipalId;
- }
- else {
- # A non-existent user can't be a group member.
- return 0;
- }
- }
-
- # Ask if it has the member in question
- return $group->HasMember( $args{'PrincipalId'} );
-}
-
-
-
-=head2 IsRequestor PRINCIPAL_ID
-
-Takes an L<RT::Principal> id.
-
-Returns true if the principal is a requestor of the current ticket.
-
-=cut
-
-sub IsRequestor {
- my $self = shift;
- my $person = shift;
-
- return ( $self->IsWatcher( Type => 'Requestor', PrincipalId => $person ) );
-
-};
-
-
-
-=head2 IsCc PRINCIPAL_ID
-
- Takes an RT::Principal id.
- Returns true if the principal is a Cc of the current ticket.
-
-
-=cut
-
-sub IsCc {
- my $self = shift;
- my $cc = shift;
-
- return ( $self->IsWatcher( Type => 'Cc', PrincipalId => $cc ) );
-
-}
-
-
-
-=head2 IsAdminCc PRINCIPAL_ID
-
- Takes an RT::Principal id.
- Returns true if the principal is an AdminCc of the current ticket.
-
-=cut
-
-sub IsAdminCc {
- my $self = shift;
- my $person = shift;
-
- return ( $self->IsWatcher( Type => 'AdminCc', PrincipalId => $person ) );
-
-}
-
-
-
-=head2 IsOwner
-
- Takes an RT::User object. Returns true if that user is this ticket's owner.
-returns undef otherwise
-
-=cut
-
-sub IsOwner {
- my $self = shift;
- my $person = shift;
-
- # no ACL check since this is used in acl decisions
- # unless ($self->CurrentUserHasRight('ShowTicket')) {
- # return(undef);
- # }
-
- #Tickets won't yet have owners when they're being created.
- unless ( $self->OwnerObj->id ) {
- return (undef);
- }
-
- if ( $person->id == $self->OwnerObj->id ) {
- return (1);
- }
- else {
- return (undef);
- }
-}
-
-
-
-
-
-=head2 TransactionAddresses
-
-Returns a composite hashref of the results of L<RT::Transaction/Addresses> for
-all this ticket's Create, Comment or Correspond transactions. The keys are
-stringified email addresses. Each value is an L<Email::Address> object.
-
-NOTE: For performance reasons, this method might want to skip transactions and go straight for attachments. But to make that work right, we're going to need to go and walk around the access control in Attachment.pm's sub _Value.
-
-=cut
-
-
-sub TransactionAddresses {
- my $self = shift;
- my $txns = $self->Transactions;
-
- my %addresses = ();
-
- my $attachments = RT::Attachments->new( $self->CurrentUser );
- $attachments->LimitByTicket( $self->id );
- $attachments->Columns( qw( id Headers TransactionId));
-
-
- foreach my $type (qw(Create Comment Correspond)) {
- $attachments->Limit( ALIAS => $attachments->TransactionAlias,
- FIELD => 'Type',
- OPERATOR => '=',
- VALUE => $type,
- ENTRYAGGREGATOR => 'OR',
- CASESENSITIVE => 1
- );
- }
-
- while ( my $att = $attachments->Next ) {
- foreach my $addrlist ( values %{$att->Addresses } ) {
- foreach my $addr (@$addrlist) {
-
-# Skip addresses without a phrase (things that are just raw addresses) if we have a phrase
- next
- if ( $addresses{ $addr->address }
- && $addresses{ $addr->address }->phrase
- && not $addr->phrase );
-
- # skips "comment-only" addresses
- next unless ( $addr->address );
- $addresses{ $addr->address } = $addr;
- }
- }
- }
-
- return \%addresses;
-
-}
-
-
-
-
-
-
-sub ValidateQueue {
- my $self = shift;
- my $Value = shift;
-
- if ( !$Value ) {
- $RT::Logger->warning( " RT:::Queue::ValidateQueue called with a null value. this isn't ok.");
- return (1);
- }
-
- my $QueueObj = RT::Queue->new( $self->CurrentUser );
- my $id = $QueueObj->Load($Value);
-
- if ($id) {
- return (1);
- }
- else {
- return (undef);
- }
-}
-
-
-
-sub SetQueue {
- my $self = shift;
- my $NewQueue = shift;
-
- #Redundant. ACL gets checked in _Set;
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- my $NewQueueObj = RT::Queue->new( $self->CurrentUser );
- $NewQueueObj->Load($NewQueue);
-
- unless ( $NewQueueObj->Id() ) {
- return ( 0, $self->loc("That queue does not exist") );
- }
-
- if ( $NewQueueObj->Id == $self->QueueObj->Id ) {
- return ( 0, $self->loc('That is the same value') );
- }
- unless ( $self->CurrentUser->HasRight( Right => 'CreateTicket', Object => $NewQueueObj)) {
- return ( 0, $self->loc("You may not create requests in that queue.") );
- }
-
- my $new_status;
- my $old_lifecycle = $self->QueueObj->Lifecycle;
- my $new_lifecycle = $NewQueueObj->Lifecycle;
- if ( $old_lifecycle->Name ne $new_lifecycle->Name ) {
- unless ( $old_lifecycle->HasMoveMap( $new_lifecycle ) ) {
- return ( 0, $self->loc("There is no mapping for statuses between these queues. Contact your system administrator.") );
- }
- $new_status = $old_lifecycle->MoveMap( $new_lifecycle )->{ lc $self->Status };
- return ( 0, $self->loc("Mapping between queues' lifecycles is incomplete. Contact your system administrator.") )
- unless $new_status;
- }
-
- if ( $new_status ) {
- my $clone = RT::Ticket->new( RT->SystemUser );
- $clone->Load( $self->Id );
- unless ( $clone->Id ) {
- return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) );
- }
-
- my $now = RT::Date->new( $self->CurrentUser );
- $now->SetToNow;
-
- my $old_status = $clone->Status;
-
- #If we're changing the status from initial in old to not intial in new,
- # record that we've started
- if ( $old_lifecycle->IsInitial($old_status) && !$new_lifecycle->IsInitial($new_status) && $clone->StartedObj->Unix == 0 ) {
- #Set the Started time to "now"
- $clone->_Set(
- Field => 'Started',
- Value => $now->ISO,
- RecordTransaction => 0
- );
- }
-
- #When we close a ticket, set the 'Resolved' attribute to now.
- # It's misnamed, but that's just historical.
- if ( $new_lifecycle->IsInactive($new_status) ) {
- $clone->_Set(
- Field => 'Resolved',
- Value => $now->ISO,
- RecordTransaction => 0,
- );
- }
-
- #Actually update the status
- my ($val, $msg)= $clone->_Set(
- Field => 'Status',
- Value => $new_status,
- RecordTransaction => 0,
- );
- $RT::Logger->error( 'Status change failed on queue change: '. $msg )
- unless $val;
- }
-
- my ($status, $msg) = $self->_Set( Field => 'Queue', Value => $NewQueueObj->Id() );
-
- if ( $status ) {
- # Clear the queue object cache;
- $self->{_queue_obj} = undef;
-
- # Untake the ticket if we have no permissions in the new queue
- unless ( $self->OwnerObj->HasRight( Right => 'OwnTicket', Object => $NewQueueObj ) ) {
- my $clone = RT::Ticket->new( RT->SystemUser );
- $clone->Load( $self->Id );
- unless ( $clone->Id ) {
- return ( 0, $self->loc("Couldn't load copy of ticket #[_1].", $self->Id) );
- }
- my ($status, $msg) = $clone->SetOwner( RT->Nobody->Id, 'Force' );
- $RT::Logger->error("Couldn't set owner on queue change: $msg") unless $status;
- }
-
- # On queue change, change queue for reminders too
- my $reminder_collection = $self->Reminders->Collection;
- while ( my $reminder = $reminder_collection->Next ) {
- my ($status, $msg) = $reminder->SetQueue($NewQueue);
- $RT::Logger->error('Queue change failed for reminder #' . $reminder->Id . ': ' . $msg) unless $status;
- }
- }
-
- return ($status, $msg);
-}
-
-
-
-=head2 QueueObj
-
-Takes nothing. returns this ticket's queue object
-
-=cut
-
-sub QueueObj {
- my $self = shift;
-
- if(!$self->{_queue_obj} || ! $self->{_queue_obj}->id) {
-
- $self->{_queue_obj} = RT::Queue->new( $self->CurrentUser );
-
- #We call __Value so that we can avoid the ACL decision and some deep recursion
- my ($result) = $self->{_queue_obj}->Load( $self->__Value('Queue') );
- }
- return ($self->{_queue_obj});
-}
-
-sub SetSubject {
- my $self = shift;
- my $value = shift;
- $value =~ s/\n//g;
- return $self->_Set( Field => 'Subject', Value => $value );
-}
-
-=head2 SubjectTag
-
-Takes nothing. Returns SubjectTag for this ticket. Includes
-queue's subject tag or rtname if that is not set, ticket
-id and braces, for example:
-
- [support.example.com #123456]
-
-=cut
-
-sub SubjectTag {
- my $self = shift;
- return
- '['
- . ($self->QueueObj->SubjectTag || RT->Config->Get('rtname'))
- .' #'. $self->id
- .']'
- ;
-}
-
-
-=head2 DueObj
-
- Returns an RT::Date object containing this ticket's due date
-
-=cut
-
-sub DueObj {
- my $self = shift;
-
- my $time = RT::Date->new( $self->CurrentUser );
-
- # -1 is RT::Date slang for never
- if ( my $due = $self->Due ) {
- $time->Set( Format => 'sql', Value => $due );
- }
- else {
- $time->Set( Format => 'unix', Value => -1 );
- }
-
- return $time;
-}
-
-
-
-=head2 DueAsString
-
-Returns this ticket's due date as a human readable string
-
-=cut
-
-sub DueAsString {
- my $self = shift;
- return $self->DueObj->AsString();
-}
-
-
-
-=head2 ResolvedObj
-
- Returns an RT::Date object of this ticket's 'resolved' time.
-
-=cut
-
-sub ResolvedObj {
- my $self = shift;
-
- my $time = RT::Date->new( $self->CurrentUser );
- $time->Set( Format => 'sql', Value => $self->Resolved );
- return $time;
-}
-
-
-=head2 FirstActiveStatus
-
-Returns the first active status that the ticket could transition to,
-according to its current Queue's lifecycle. May return undef if there
-is no such possible status to transition to, or we are already in it.
-This is used in L<RT::Action::AutoOpen>, for instance.
-
-=cut
-
-sub FirstActiveStatus {
- my $self = shift;
-
- my $lifecycle = $self->QueueObj->Lifecycle;
- my $status = $self->Status;
- my @active = $lifecycle->Active;
- # no change if no active statuses in the lifecycle
- return undef unless @active;
-
- # no change if the ticket is already has first status from the list of active
- return undef if lc $status eq lc $active[0];
-
- my ($next) = grep $lifecycle->IsActive($_), $lifecycle->Transitions($status);
- return $next;
-}
-
-=head2 FirstInactiveStatus
-
-Returns the first inactive status that the ticket could transition to,
-according to its current Queue's lifecycle. May return undef if there
-is no such possible status to transition to, or we are already in it.
-This is used in resolve action in UnsafeEmailCommands, for instance.
-
-=cut
-
-sub FirstInactiveStatus {
- my $self = shift;
-
- my $lifecycle = $self->QueueObj->Lifecycle;
- my $status = $self->Status;
- my @inactive = $lifecycle->Inactive;
- # no change if no inactive statuses in the lifecycle
- return undef unless @inactive;
-
- # no change if the ticket is already has first status from the list of inactive
- return undef if lc $status eq lc $inactive[0];
-
- my ($next) = grep $lifecycle->IsInactive($_), $lifecycle->Transitions($status);
- return $next;
-}
-
-=head2 SetStarted
-
-Takes a date in ISO format or undef
-Returns a transaction id and a message
-The client calls "Start" to note that the project was started on the date in $date.
-A null date means "now"
-
-=cut
-
-sub SetStarted {
- my $self = shift;
- my $time = shift || 0;
-
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- #We create a date object to catch date weirdness
- my $time_obj = RT::Date->new( $self->CurrentUser() );
- if ( $time ) {
- $time_obj->Set( Format => 'ISO', Value => $time );
- }
- else {
- $time_obj->SetToNow();
- }
-
- # We need $TicketAsSystem, in case the current user doesn't have
- # ShowTicket
- my $TicketAsSystem = RT::Ticket->new(RT->SystemUser);
- $TicketAsSystem->Load( $self->Id );
- # Now that we're starting, open this ticket
- # TODO: do we really want to force this as policy? it should be a scrip
- my $next = $TicketAsSystem->FirstActiveStatus;
-
- $self->SetStatus( $next ) if defined $next;
-
- return ( $self->_Set( Field => 'Started', Value => $time_obj->ISO ) );
-
-}
-
-
-
-=head2 StartedObj
-
- Returns an RT::Date object which contains this ticket's
-'Started' time.
-
-=cut
-
-sub StartedObj {
- my $self = shift;
-
- my $time = RT::Date->new( $self->CurrentUser );
- $time->Set( Format => 'sql', Value => $self->Started );
- return $time;
-}
-
-
-
-=head2 StartsObj
-
- Returns an RT::Date object which contains this ticket's
-'Starts' time.
-
-=cut
-
-sub StartsObj {
- my $self = shift;
-
- my $time = RT::Date->new( $self->CurrentUser );
- $time->Set( Format => 'sql', Value => $self->Starts );
- return $time;
-}
-
-
-
-=head2 ToldObj
-
- Returns an RT::Date object which contains this ticket's
-'Told' time.
-
-=cut
-
-sub ToldObj {
- my $self = shift;
-
- my $time = RT::Date->new( $self->CurrentUser );
- $time->Set( Format => 'sql', Value => $self->Told );
- return $time;
-}
-
-
-
-=head2 ToldAsString
-
-A convenience method that returns ToldObj->AsString
-
-TODO: This should be deprecated
-
-=cut
-
-sub ToldAsString {
- my $self = shift;
- if ( $self->Told ) {
- return $self->ToldObj->AsString();
- }
- else {
- return ("Never");
- }
-}
-
-
-
-=head2 TimeWorkedAsString
-
-Returns the amount of time worked on this ticket as a Text String
-
-=cut
-
-sub TimeWorkedAsString {
- my $self = shift;
- my $value = $self->TimeWorked;
-
- # return the # of minutes worked turned into seconds and written as
- # a simple text string, this is not really a date object, but if we
- # diff a number of seconds vs the epoch, we'll get a nice description
- # of time worked.
- return "" unless $value;
- return RT::Date->new( $self->CurrentUser )
- ->DurationAsString( $value * 60 );
-}
-
-
-
-=head2 TimeLeftAsString
-
-Returns the amount of time left on this ticket as a Text String
-
-=cut
-
-sub TimeLeftAsString {
- my $self = shift;
- my $value = $self->TimeLeft;
- return "" unless $value;
- return RT::Date->new( $self->CurrentUser )
- ->DurationAsString( $value * 60 );
-}
-
-
-
-
-=head2 Comment
-
-Comment on this ticket.
-Takes a hash with the following attributes:
-If MIMEObj is undefined, Content will be used to build a MIME::Entity for this
-comment.
-
-MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
-
-If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
-They will, however, be prepared and you'll be able to access them through the TransactionObj
-
-Returns: Transaction id, Error Message, Transaction Object
-(note the different order from Create()!)
-
-=cut
-
-sub Comment {
- my $self = shift;
-
- my %args = ( CcMessageTo => undef,
- BccMessageTo => undef,
- MIMEObj => undef,
- Content => undef,
- TimeTaken => 0,
- DryRun => 0,
- @_ );
-
- unless ( ( $self->CurrentUserHasRight('CommentOnTicket') )
- or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
- return ( 0, $self->loc("Permission Denied"), undef );
- }
- $args{'NoteType'} = 'Comment';
-
- $RT::Handle->BeginTransaction();
- if ($args{'DryRun'}) {
- $args{'CommitScrips'} = 0;
- }
-
- my @results = $self->_RecordNote(%args);
- if ($args{'DryRun'}) {
- $RT::Handle->Rollback();
- } else {
- $RT::Handle->Commit();
- }
-
- return(@results);
-}
-
-
-=head2 Correspond
-
-Correspond on this ticket.
-Takes a hashref with the following attributes:
-
-
-MIMEObj, TimeTaken, CcMessageTo, BccMessageTo, Content, DryRun
-
-if there's no MIMEObj, Content is used to build a MIME::Entity object
-
-If DryRun is defined, this update WILL NOT BE RECORDED. Scrips will not be committed.
-They will, however, be prepared and you'll be able to access them through the TransactionObj
-
-Returns: Transaction id, Error Message, Transaction Object
-(note the different order from Create()!)
-
-
-=cut
-
-sub Correspond {
- my $self = shift;
- my %args = ( CcMessageTo => undef,
- BccMessageTo => undef,
- MIMEObj => undef,
- Content => undef,
- TimeTaken => 0,
- @_ );
-
- unless ( ( $self->CurrentUserHasRight('ReplyToTicket') )
- or ( $self->CurrentUserHasRight('ModifyTicket') ) ) {
- return ( 0, $self->loc("Permission Denied"), undef );
- }
- $args{'NoteType'} = 'Correspond';
-
- $RT::Handle->BeginTransaction();
- if ($args{'DryRun'}) {
- $args{'CommitScrips'} = 0;
- }
-
- my @results = $self->_RecordNote(%args);
-
- unless ( $results[0] ) {
- $RT::Handle->Rollback();
- return @results;
- }
-
- #Set the last told date to now if this isn't mail from the requestor.
- #TODO: Note that this will wrongly ack mail from any non-requestor as a "told"
- unless ( $self->IsRequestor($self->CurrentUser->id) ) {
- my %squelch;
- $squelch{$_}++ for map {$_->Content} $self->SquelchMailTo, $results[2]->SquelchMailTo;
- $self->_SetTold
- if grep {not $squelch{$_}} $self->Requestors->MemberEmailAddresses;
- }
-
- if ($args{'DryRun'}) {
- $RT::Handle->Rollback();
- } else {
- $RT::Handle->Commit();
- }
-
- return (@results);
-
-}
-
-
-
-=head2 _RecordNote
-
-the meat of both comment and correspond.
-
-Performs no access control checks. hence, dangerous.
-
-=cut
-
-sub _RecordNote {
- my $self = shift;
- my %args = (
- CcMessageTo => undef,
- BccMessageTo => undef,
- Encrypt => undef,
- Sign => undef,
- MIMEObj => undef,
- Content => undef,
- NoteType => 'Correspond',
- TimeTaken => 0,
- CommitScrips => 1,
- SquelchMailTo => undef,
- CustomFields => {},
- @_
- );
-
- unless ( $args{'MIMEObj'} || $args{'Content'} ) {
- return ( 0, $self->loc("No message attached"), undef );
- }
-
- unless ( $args{'MIMEObj'} ) {
- $args{'MIMEObj'} = MIME::Entity->build(
- Data => ( ref $args{'Content'}? $args{'Content'}: [ $args{'Content'} ] )
- );
- }
-
- $args{'MIMEObj'}->head->replace('X-RT-Interface' => 'API')
- unless $args{'MIMEObj'}->head->get('X-RT-Interface');
-
- # convert text parts into utf-8
- RT::I18N::SetMIMEEntityToUTF8( $args{'MIMEObj'} );
-
- # If we've been passed in CcMessageTo and BccMessageTo fields,
- # add them to the mime object for passing on to the transaction handler
- # The "NotifyOtherRecipients" scripAction will look for RT-Send-Cc: and
- # RT-Send-Bcc: headers
-
-
- foreach my $type (qw/Cc Bcc/) {
- if ( defined $args{ $type . 'MessageTo' } ) {
-
- my $addresses = join ', ', (
- map { RT::User->CanonicalizeEmailAddress( $_->address ) }
- Email::Address->parse( $args{ $type . 'MessageTo' } ) );
- $args{'MIMEObj'}->head->replace( 'RT-Send-' . $type, Encode::encode_utf8( $addresses ) );
- }
- }
-
- foreach my $argument (qw(Encrypt Sign)) {
- $args{'MIMEObj'}->head->replace(
- "X-RT-$argument" => Encode::encode_utf8( $args{ $argument } )
- ) if defined $args{ $argument };
- }
-
- # If this is from an external source, we need to come up with its
- # internal Message-ID now, so all emails sent because of this
- # message have a common Message-ID
- my $org = RT->Config->Get('Organization');
- my $msgid = $args{'MIMEObj'}->head->get('Message-ID');
- unless (defined $msgid && $msgid =~ /<(rt-.*?-\d+-\d+)\.(\d+-0-0)\@\Q$org\E>/) {
- $args{'MIMEObj'}->head->set(
- 'RT-Message-ID' => Encode::encode_utf8(
- RT::Interface::Email::GenMessageId( Ticket => $self )
- )
- );
- }
-
- #Record the correspondence (write the transaction)
- my ( $Trans, $msg, $TransObj ) = $self->_NewTransaction(
- Type => $args{'NoteType'},
- Data => ( $args{'MIMEObj'}->head->get('subject') || 'No Subject' ),
- TimeTaken => $args{'TimeTaken'},
- MIMEObj => $args{'MIMEObj'},
- CommitScrips => $args{'CommitScrips'},
- SquelchMailTo => $args{'SquelchMailTo'},
- CustomFields => $args{'CustomFields'},
- );
-
- unless ($Trans) {
- $RT::Logger->err("$self couldn't init a transaction $msg");
- return ( $Trans, $self->loc("Message could not be recorded"), undef );
- }
-
- return ( $Trans, $self->loc("Message recorded"), $TransObj );
-}
-
-
-=head2 DryRun
-
-Builds a MIME object from the given C<UpdateSubject> and
-C<UpdateContent>, then calls L</Comment> or L</Correspond> with
-C<< DryRun => 1 >>, and returns the transaction so produced.
-
-=cut
-
-sub DryRun {
- my $self = shift;
- my %args = @_;
- my $action;
- if (($args{'UpdateType'} || $args{Action}) =~ /^respon(d|se)$/i ) {
- $action = 'Correspond';
- } else {
- $action = 'Comment';
- }
-
- my $Message = MIME::Entity->build(
- Type => 'text/plain',
- Subject => defined $args{UpdateSubject} ? Encode::encode_utf8( $args{UpdateSubject} ) : "",
- Charset => 'UTF-8',
- Data => $args{'UpdateContent'} || "",
- );
-
- my ( $Transaction, $Description, $Object ) = $self->$action(
- CcMessageTo => $args{'UpdateCc'},
- BccMessageTo => $args{'UpdateBcc'},
- MIMEObj => $Message,
- TimeTaken => $args{'UpdateTimeWorked'},
- DryRun => 1,
- );
- unless ( $Transaction ) {
- $RT::Logger->error("Couldn't fire '$action' action: $Description");
- }
-
- return $Object;
-}
-
-=head2 DryRunCreate
-
-Prepares a MIME mesage with the given C<Subject>, C<Cc>, and
-C<Content>, then calls L</Create> with C<< DryRun => 1 >> and returns
-the resulting L<RT::Transaction>.
-
-=cut
-
-sub DryRunCreate {
- my $self = shift;
- my %args = @_;
- my $Message = MIME::Entity->build(
- Type => 'text/plain',
- Subject => defined $args{Subject} ? Encode::encode_utf8( $args{'Subject'} ) : "",
- (defined $args{'Cc'} ?
- ( Cc => Encode::encode_utf8( $args{'Cc'} ) ) : ()),
- Charset => 'UTF-8',
- Data => $args{'Content'} || "",
- );
-
- my ( $Transaction, $Object, $Description ) = $self->Create(
- Type => $args{'Type'} || 'ticket',
- Queue => $args{'Queue'},
- Owner => $args{'Owner'},
- Requestor => $args{'Requestors'},
- Cc => $args{'Cc'},
- AdminCc => $args{'AdminCc'},
- InitialPriority => $args{'InitialPriority'},
- FinalPriority => $args{'FinalPriority'},
- TimeLeft => $args{'TimeLeft'},
- TimeEstimated => $args{'TimeEstimated'},
- TimeWorked => $args{'TimeWorked'},
- Subject => $args{'Subject'},
- Status => $args{'Status'},
- MIMEObj => $Message,
- DryRun => 1,
- );
- unless ( $Transaction ) {
- $RT::Logger->error("Couldn't fire Create action: $Description");
- }
-
- return $Object;
-}
-
-
-
-sub _Links {
- my $self = shift;
-
- #TODO: Field isn't the right thing here. but I ahave no idea what mnemonic ---
- #tobias meant by $f
- my $field = shift;
- my $type = shift || "";
-
- my $cache_key = "$field$type";
- return $self->{ $cache_key } if $self->{ $cache_key };
-
- my $links = $self->{ $cache_key }
- = RT::Links->new( $self->CurrentUser );
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- $links->Limit( FIELD => 'id', VALUE => 0, SUBCLAUSE => 'acl' );
- return $links;
- }
-
- # Maybe this ticket is a merge ticket
- #my $limit_on = 'Local'. $field;
- # at least to myself
- $links->Limit(
- FIELD => $field, #$limit_on,
- OPERATOR => 'MATCHES',
- VALUE => 'fsck.com-rt://%/ticket/'. $self->id,
- ENTRYAGGREGATOR => 'OR',
- );
- $links->Limit(
- FIELD => $field, #$limit_on,
- OPERATOR => 'MATCHES',
- VALUE => 'fsck.com-rt://%/ticket/'. $_,
- ENTRYAGGREGATOR => 'OR',
- ) foreach $self->Merged;
- $links->Limit(
- FIELD => 'Type',
- VALUE => $type,
- ) if $type;
-
- return $links;
-}
-
-
-
-=head2 DeleteLink
-
-Delete a link. takes a paramhash of Base, Target, Type, Silent,
-SilentBase and SilentTarget. Either Base or Target must be null.
-The null value will be replaced with this ticket's id.
-
-If Silent is true then no transaction would be recorded, in other
-case you can control creation of transactions on both base and
-target with SilentBase and SilentTarget respectively. By default
-both transactions are created.
-
-=cut
-
-sub DeleteLink {
- my $self = shift;
- my %args = (
- Base => undef,
- Target => undef,
- Type => undef,
- Silent => undef,
- SilentBase => undef,
- SilentTarget => undef,
- @_
- );
-
- unless ( $args{'Target'} || $args{'Base'} ) {
- $RT::Logger->error("Base or Target must be specified");
- return ( 0, $self->loc('Either base or target must be specified') );
- }
-
- #check acls
- my $right = 0;
- $right++ if $self->CurrentUserHasRight('ModifyTicket');
- if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- # If the other URI is an RT::Ticket, we want to make sure the user
- # can modify it too...
- my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
- return (0, $msg) unless $status;
- if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
- $right++;
- }
- if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
- ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
- {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- my ($val, $Msg) = $self->SUPER::_DeleteLink(%args);
- return ( 0, $Msg ) unless $val;
-
- return ( $val, $Msg ) if $args{'Silent'};
-
- my ($direction, $remote_link);
-
- if ( $args{'Base'} ) {
- $remote_link = $args{'Base'};
- $direction = 'Target';
- }
- elsif ( $args{'Target'} ) {
- $remote_link = $args{'Target'};
- $direction = 'Base';
- }
-
- my $remote_uri = RT::URI->new( $self->CurrentUser );
- $remote_uri->FromURI( $remote_link );
-
- unless ( $args{ 'Silent'. $direction } ) {
- my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
- Type => 'DeleteLink',
- Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
- OldValue => $remote_uri->URI || $remote_link,
- TimeTaken => 0
- );
- $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
- }
-
- if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
- my $OtherObj = $remote_uri->Object;
- my ( $val, $Msg ) = $OtherObj->_NewTransaction(
- Type => 'DeleteLink',
- Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
- : $LINKDIRMAP{$args{'Type'}}->{Target},
- OldValue => $self->URI,
- ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
- TimeTaken => 0,
- );
- $RT::Logger->error("Couldn't create transaction: $Msg") unless $val;
- }
-
- return ( $val, $Msg );
-}
-
-
-
-=head2 AddLink
-
-Takes a paramhash of Type and one of Base or Target. Adds that link to this ticket.
-
-If Silent is true then no transaction would be recorded, in other
-case you can control creation of transactions on both base and
-target with SilentBase and SilentTarget respectively. By default
-both transactions are created.
-
-=cut
-
-sub AddLink {
- my $self = shift;
- my %args = ( Target => '',
- Base => '',
- Type => '',
- Silent => undef,
- SilentBase => undef,
- SilentTarget => undef,
- @_ );
-
- unless ( $args{'Target'} || $args{'Base'} ) {
- $RT::Logger->error("Base or Target must be specified");
- return ( 0, $self->loc('Either base or target must be specified') );
- }
-
- my $right = 0;
- $right++ if $self->CurrentUserHasRight('ModifyTicket');
- if ( !$right && RT->Config->Get( 'StrictLinkACL' ) ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- # If the other URI is an RT::Ticket, we want to make sure the user
- # can modify it too...
- my ($status, $msg, $other_ticket) = $self->__GetTicketFromURI( URI => $args{'Target'} || $args{'Base'} );
- return (0, $msg) unless $status;
- if ( !$other_ticket || $other_ticket->CurrentUserHasRight('ModifyTicket') ) {
- $right++;
- }
- if ( ( !RT->Config->Get( 'StrictLinkACL' ) && $right == 0 ) ||
- ( RT->Config->Get( 'StrictLinkACL' ) && $right < 2 ) )
- {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- return ( 0, "Can't link to a deleted ticket" )
- if $other_ticket && lc $other_ticket->Status eq 'deleted';
-
- return $self->_AddLink(%args);
-}
-
-sub __GetTicketFromURI {
- my $self = shift;
- my %args = ( URI => '', @_ );
-
- # If the other URI is an RT::Ticket, we want to make sure the user
- # can modify it too...
- my $uri_obj = RT::URI->new( $self->CurrentUser );
- unless ($uri_obj->FromURI( $args{'URI'} )) {
- my $msg = $self->loc( "Couldn't resolve '[_1]' into a URI.", $args{'URI'} );
- $RT::Logger->warning( $msg );
- return( 0, $msg );
- }
- my $obj = $uri_obj->Resolver->Object;
- unless ( UNIVERSAL::isa($obj, 'RT::Ticket') && $obj->id ) {
- return (1, 'Found not a ticket', undef);
- }
- return (1, 'Found ticket', $obj);
-}
-
-=head2 _AddLink
-
-Private non-acled variant of AddLink so that links can be added during create.
-
-=cut
-
-sub _AddLink {
- my $self = shift;
- my %args = ( Target => '',
- Base => '',
- Type => '',
- Silent => undef,
- SilentBase => undef,
- SilentTarget => undef,
- @_ );
-
- my ($val, $msg, $exist) = $self->SUPER::_AddLink(%args);
- return ($val, $msg) if !$val || $exist;
- return ($val, $msg) if $args{'Silent'};
-
- my ($direction, $remote_link);
- if ( $args{'Target'} ) {
- $remote_link = $args{'Target'};
- $direction = 'Base';
- } elsif ( $args{'Base'} ) {
- $remote_link = $args{'Base'};
- $direction = 'Target';
- }
-
- my $remote_uri = RT::URI->new( $self->CurrentUser );
- $remote_uri->FromURI( $remote_link );
-
- unless ( $args{ 'Silent'. $direction } ) {
- my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
- Type => 'AddLink',
- Field => $LINKDIRMAP{$args{'Type'}}->{$direction},
- NewValue => $remote_uri->URI || $remote_link,
- TimeTaken => 0
- );
- $RT::Logger->error("Couldn't create transaction: $Msg") unless $Trans;
- }
-
- if ( !$args{ 'Silent'. ( $direction eq 'Target'? 'Base': 'Target' ) } && $remote_uri->IsLocal ) {
- my $OtherObj = $remote_uri->Object;
- my ( $val, $msg ) = $OtherObj->_NewTransaction(
- Type => 'AddLink',
- Field => $direction eq 'Target' ? $LINKDIRMAP{$args{'Type'}}->{Base}
- : $LINKDIRMAP{$args{'Type'}}->{Target},
- NewValue => $self->URI,
- ActivateScrips => !RT->Config->Get('LinkTransactionsRun1Scrip'),
- TimeTaken => 0,
- );
- $RT::Logger->error("Couldn't create transaction: $msg") unless $val;
- }
-
- return ( $val, $msg );
-}
-
-
-
-
-=head2 MergeInto
-
-MergeInto take the id of the ticket to merge this ticket into.
-
-=cut
-
-sub MergeInto {
- my $self = shift;
- my $ticket_id = shift;
-
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- # Load up the new ticket.
- my $MergeInto = RT::Ticket->new($self->CurrentUser);
- $MergeInto->Load($ticket_id);
-
- # make sure it exists.
- unless ( $MergeInto->Id ) {
- return ( 0, $self->loc("New ticket doesn't exist") );
- }
-
- # Make sure the current user can modify the new ticket.
- unless ( $MergeInto->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- delete $MERGE_CACHE{'effective'}{ $self->id };
- delete @{ $MERGE_CACHE{'merged'} }{
- $ticket_id, $MergeInto->id, $self->id
- };
-
- $RT::Handle->BeginTransaction();
-
- $self->_MergeInto( $MergeInto );
-
- $RT::Handle->Commit();
-
- return ( 1, $self->loc("Merge Successful") );
-}
-
-sub _MergeInto {
- my $self = shift;
- my $MergeInto = shift;
-
-
- # We use EffectiveId here even though it duplicates information from
- # the links table becasue of the massive performance hit we'd take
- # by trying to do a separate database query for merge info everytime
- # loaded a ticket.
-
- #update this ticket's effective id to the new ticket's id.
- my ( $id_val, $id_msg ) = $self->__Set(
- Field => 'EffectiveId',
- Value => $MergeInto->Id()
- );
-
- unless ($id_val) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Merge failed. Couldn't set EffectiveId") );
- }
-
-
- my $force_status = $self->QueueObj->Lifecycle->DefaultOnMerge;
- if ( $force_status && $force_status ne $self->__Value('Status') ) {
- my ( $status_val, $status_msg )
- = $self->__Set( Field => 'Status', Value => $force_status );
-
- unless ($status_val) {
- $RT::Handle->Rollback();
- $RT::Logger->error(
- "Couldn't set status to $force_status. RT's Database may be inconsistent."
- );
- return ( 0, $self->loc("Merge failed. Couldn't set Status") );
- }
- }
-
- # update all the links that point to that old ticket
- my $old_links_to = RT::Links->new($self->CurrentUser);
- $old_links_to->Limit(FIELD => 'Target', VALUE => $self->URI);
-
- my %old_seen;
- while (my $link = $old_links_to->Next) {
- if (exists $old_seen{$link->Base."-".$link->Type}) {
- $link->Delete;
- }
- elsif ($link->Base eq $MergeInto->URI) {
- $link->Delete;
- } else {
- # First, make sure the link doesn't already exist. then move it over.
- my $tmp = RT::Link->new(RT->SystemUser);
- $tmp->LoadByCols(Base => $link->Base, Type => $link->Type, LocalTarget => $MergeInto->id);
- if ($tmp->id) {
- $link->Delete;
- } else {
- $link->SetTarget($MergeInto->URI);
- $link->SetLocalTarget($MergeInto->id);
- }
- $old_seen{$link->Base."-".$link->Type} =1;
- }
-
- }
-
- my $old_links_from = RT::Links->new($self->CurrentUser);
- $old_links_from->Limit(FIELD => 'Base', VALUE => $self->URI);
-
- while (my $link = $old_links_from->Next) {
- if (exists $old_seen{$link->Type."-".$link->Target}) {
- $link->Delete;
- }
- if ($link->Target eq $MergeInto->URI) {
- $link->Delete;
- } else {
- # First, make sure the link doesn't already exist. then move it over.
- my $tmp = RT::Link->new(RT->SystemUser);
- $tmp->LoadByCols(Target => $link->Target, Type => $link->Type, LocalBase => $MergeInto->id);
- if ($tmp->id) {
- $link->Delete;
- } else {
- $link->SetBase($MergeInto->URI);
- $link->SetLocalBase($MergeInto->id);
- $old_seen{$link->Type."-".$link->Target} =1;
- }
- }
-
- }
-
- # Update time fields
- foreach my $type (qw(TimeEstimated TimeWorked TimeLeft)) {
-
- my $mutator = "Set$type";
- $MergeInto->$mutator(
- ( $MergeInto->$type() || 0 ) + ( $self->$type() || 0 ) );
-
- }
-#add all of this ticket's watchers to that ticket.
- foreach my $watcher_type (qw(Requestors Cc AdminCc)) {
-
- my $people = $self->$watcher_type->MembersObj;
- my $addwatcher_type = $watcher_type;
- $addwatcher_type =~ s/s$//;
-
- while ( my $watcher = $people->Next ) {
-
- my ($val, $msg) = $MergeInto->_AddWatcher(
- Type => $addwatcher_type,
- Silent => 1,
- PrincipalId => $watcher->MemberId
- );
- unless ($val) {
- $RT::Logger->debug($msg);
- }
- }
-
- }
-
- #find all of the tickets that were merged into this ticket.
- my $old_mergees = RT::Tickets->new( $self->CurrentUser );
- $old_mergees->Limit(
- FIELD => 'EffectiveId',
- OPERATOR => '=',
- VALUE => $self->Id
- );
-
- # update their EffectiveId fields to the new ticket's id
- while ( my $ticket = $old_mergees->Next() ) {
- my ( $val, $msg ) = $ticket->__Set(
- Field => 'EffectiveId',
- Value => $MergeInto->Id()
- );
- }
-
- #make a new link: this ticket is merged into that other ticket.
- $self->AddLink( Type => 'MergedInto', Target => $MergeInto->Id());
-
- $MergeInto->_SetLastUpdated;
-}
-
-=head2 Merged
-
-Returns list of tickets' ids that's been merged into this ticket.
-
-=cut
-
-sub Merged {
- my $self = shift;
-
- my $id = $self->id;
- return @{ $MERGE_CACHE{'merged'}{ $id } }
- if $MERGE_CACHE{'merged'}{ $id };
-
- my $mergees = RT::Tickets->new( $self->CurrentUser );
- $mergees->Limit(
- FIELD => 'EffectiveId',
- VALUE => $id,
- );
- $mergees->Limit(
- FIELD => 'id',
- OPERATOR => '!=',
- VALUE => $id,
- );
- return @{ $MERGE_CACHE{'merged'}{ $id } ||= [] }
- = map $_->id, @{ $mergees->ItemsArrayRef || [] };
-}
-
-
-
-
-
-=head2 OwnerObj
-
-Takes nothing and returns an RT::User object of
-this ticket's owner
-
-=cut
-
-sub OwnerObj {
- my $self = shift;
-
- #If this gets ACLed, we lose on a rights check in User.pm and
- #get deep recursion. if we need ACLs here, we need
- #an equiv without ACLs
-
- my $owner = RT::User->new( $self->CurrentUser );
- $owner->Load( $self->__Value('Owner') );
-
- #Return the owner object
- return ($owner);
-}
-
-
-
-=head2 OwnerAsString
-
-Returns the owner's email address
-
-=cut
-
-sub OwnerAsString {
- my $self = shift;
- return ( $self->OwnerObj->EmailAddress );
-
-}
-
-
-
-=head2 SetOwner
-
-Takes two arguments:
- the Id or Name of the owner
-and (optionally) the type of the SetOwner Transaction. It defaults
-to 'Set'. 'Steal' is also a valid option.
-
-
-=cut
-
-sub SetOwner {
- my $self = shift;
- my $NewOwner = shift;
- my $Type = shift || "Set";
-
- $RT::Handle->BeginTransaction();
-
- $self->_SetLastUpdated(); # lock the ticket
- $self->Load( $self->id ); # in case $self changed while waiting for lock
-
- my $OldOwnerObj = $self->OwnerObj;
-
- my $NewOwnerObj = RT::User->new( $self->CurrentUser );
- $NewOwnerObj->Load( $NewOwner );
- unless ( $NewOwnerObj->Id ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("That user does not exist") );
- }
-
-
- # must have ModifyTicket rights
- # or TakeTicket/StealTicket and $NewOwner is self
- # see if it's a take
- if ( $OldOwnerObj->Id == RT->Nobody->Id ) {
- unless ( $self->CurrentUserHasRight('ModifyTicket')
- || $self->CurrentUserHasRight('TakeTicket') ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Permission Denied") );
- }
- }
-
- # see if it's a steal
- elsif ( $OldOwnerObj->Id != RT->Nobody->Id
- && $OldOwnerObj->Id != $self->CurrentUser->id ) {
-
- unless ( $self->CurrentUserHasRight('ModifyTicket')
- || $self->CurrentUserHasRight('StealTicket') ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Permission Denied") );
- }
- }
- else {
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Permission Denied") );
- }
- }
-
- # If we're not stealing and the ticket has an owner and it's not
- # the current user
- if ( $Type ne 'Steal' and $Type ne 'Force'
- and $OldOwnerObj->Id != RT->Nobody->Id
- and $OldOwnerObj->Id != $self->CurrentUser->Id )
- {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("You can only take tickets that are unowned") )
- if $NewOwnerObj->id == $self->CurrentUser->id;
- return (
- 0,
- $self->loc("You can only reassign tickets that you own or that are unowned" )
- );
- }
-
- #If we've specified a new owner and that user can't modify the ticket
- elsif ( !$NewOwnerObj->HasRight( Right => 'OwnTicket', Object => $self ) ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("That user may not own tickets in that queue") );
- }
-
- # If the ticket has an owner and it's the new owner, we don't need
- # To do anything
- elsif ( $NewOwnerObj->Id == $OldOwnerObj->Id ) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("That user already owns that ticket") );
- }
-
- # Delete the owner in the owner group, then add a new one
- # TODO: is this safe? it's not how we really want the API to work
- # for most things, but it's fast.
- my ( $del_id, $del_msg );
- for my $owner (@{$self->OwnerGroup->MembersObj->ItemsArrayRef}) {
- ($del_id, $del_msg) = $owner->Delete();
- last unless ($del_id);
- }
-
- unless ($del_id) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Could not change owner: [_1]", $del_msg) );
- }
-
- my ( $add_id, $add_msg ) = $self->OwnerGroup->_AddMember(
- PrincipalId => $NewOwnerObj->PrincipalId,
- InsideTransaction => 1 );
- unless ($add_id) {
- $RT::Handle->Rollback();
- return ( 0, $self->loc("Could not change owner: [_1]", $add_msg ) );
- }
-
- # We call set twice with slightly different arguments, so
- # as to not have an SQL transaction span two RT transactions
-
- my ( $val, $msg ) = $self->_Set(
- Field => 'Owner',
- RecordTransaction => 0,
- Value => $NewOwnerObj->Id,
- TimeTaken => 0,
- TransactionType => 'Set',
- CheckACL => 0, # don't check acl
- );
-
- unless ($val) {
- $RT::Handle->Rollback;
- return ( 0, $self->loc("Could not change owner: [_1]", $msg) );
- }
-
- ($val, $msg) = $self->_NewTransaction(
- Type => 'Set',
- Field => 'Owner',
- NewValue => $NewOwnerObj->Id,
- OldValue => $OldOwnerObj->Id,
- TimeTaken => 0,
- );
-
- if ( $val ) {
- $msg = $self->loc( "Owner changed from [_1] to [_2]",
- $OldOwnerObj->Name, $NewOwnerObj->Name );
- }
- else {
- $RT::Handle->Rollback();
- return ( 0, $msg );
- }
-
- $RT::Handle->Commit();
-
- return ( $val, $msg );
-}
-
-
-
-=head2 Take
-
-A convenince method to set the ticket's owner to the current user
-
-=cut
-
-sub Take {
- my $self = shift;
- return ( $self->SetOwner( $self->CurrentUser->Id, 'Take' ) );
-}
-
-
-
-=head2 Untake
-
-Convenience method to set the owner to 'nobody' if the current user is the owner.
-
-=cut
-
-sub Untake {
- my $self = shift;
- return ( $self->SetOwner( RT->Nobody->UserObj->Id, 'Untake' ) );
-}
-
-
-
-=head2 Steal
-
-A convenience method to change the owner of the current ticket to the
-current user. Even if it's owned by another user.
-
-=cut
-
-sub Steal {
- my $self = shift;
-
- if ( $self->IsOwner( $self->CurrentUser ) ) {
- return ( 0, $self->loc("You already own this ticket") );
- }
- else {
- return ( $self->SetOwner( $self->CurrentUser->Id, 'Steal' ) );
-
- }
-
-}
-
-
-
-
-
-=head2 ValidateStatus STATUS
-
-Takes a string. Returns true if that status is a valid status for this ticket.
-Returns false otherwise.
-
-=cut
-
-sub ValidateStatus {
- my $self = shift;
- my $status = shift;
-
- #Make sure the status passed in is valid
- return 1 if $self->QueueObj->IsValidStatus($status);
-
- my $i = 0;
- while ( my $caller = (caller($i++))[3] ) {
- return 1 if $caller eq 'RT::Ticket::SetQueue';
- }
-
- return 0;
-}
-
-sub Status {
- my $self = shift;
- my $value = $self->_Value( 'Status' );
- return $value unless $self->QueueObj;
- return $self->QueueObj->Lifecycle->CanonicalCase( $value );
-}
-
-=head2 SetStatus STATUS
-
-Set this ticket's status. STATUS can be one of: new, open, stalled, resolved, rejected or deleted.
-
-Alternatively, you can pass in a list of named parameters (Status => STATUS, Force => FORCE, SetStarted => SETSTARTED ).
-If FORCE is true, ignore unresolved dependencies and force a status change.
-if SETSTARTED is true( it's the default value), set Started to current datetime if Started
-is not set and the status is changed from initial to not initial.
-
-=cut
-
-sub SetStatus {
- my $self = shift;
- my %args;
- if (@_ == 1) {
- $args{Status} = shift;
- }
- else {
- %args = (@_);
- }
-
- # this only allows us to SetStarted, not we must SetStarted.
- # this option was added for rtir initially
- $args{SetStarted} = 1 unless exists $args{SetStarted};
-
-
- my $lifecycle = $self->QueueObj->Lifecycle;
-
- my $new = lc $args{'Status'};
- unless ( $lifecycle->IsValid( $new ) ) {
- return (0, $self->loc("Status '[_1]' isn't a valid status for tickets in this queue.", $self->loc($new)));
- }
-
- my $old = $self->__Value('Status');
- unless ( $lifecycle->IsTransition( $old => $new ) ) {
- return (0, $self->loc("You can't change status from '[_1]' to '[_2]'.", $self->loc($old), $self->loc($new)));
- }
-
- my $check_right = $lifecycle->CheckRight( $old => $new );
- unless ( $self->CurrentUserHasRight( $check_right ) ) {
- return ( 0, $self->loc('Permission Denied') );
- }
-
- if ( !$args{Force} && $lifecycle->IsInactive( $new ) && $self->HasUnresolvedDependencies) {
- return (0, $self->loc('That ticket has unresolved dependencies'));
- }
-
- my $now = RT::Date->new( $self->CurrentUser );
- $now->SetToNow();
-
- my $raw_started = RT::Date->new(RT->SystemUser);
- $raw_started->Set(Format => 'ISO', Value => $self->__Value('Started'));
-
- #If we're changing the status from new, record that we've started
- if ( $args{SetStarted} && $lifecycle->IsInitial($old) && !$lifecycle->IsInitial($new) && !$raw_started->Unix) {
- #Set the Started time to "now"
- $self->_Set(
- Field => 'Started',
- Value => $now->ISO,
- RecordTransaction => 0
- );
- }
-
- #When we close a ticket, set the 'Resolved' attribute to now.
- # It's misnamed, but that's just historical.
- if ( $lifecycle->IsInactive($new) ) {
- $self->_Set(
- Field => 'Resolved',
- Value => $now->ISO,
- RecordTransaction => 0,
- );
- }
-
- #Actually update the status
- my ($val, $msg)= $self->_Set(
- Field => 'Status',
- Value => $new,
- TimeTaken => 0,
- CheckACL => 0,
- TransactionType => 'Status',
- );
- return ($val, $msg);
-}
-
-
-
-=head2 Delete
-
-Takes no arguments. Marks this ticket for garbage collection
-
-=cut
-
-sub Delete {
- my $self = shift;
- unless ( $self->QueueObj->Lifecycle->IsValid('deleted') ) {
- return (0, $self->loc('Delete operation is disabled by lifecycle configuration') ); #loc
- }
- return ( $self->SetStatus('deleted') );
-}
-
-
-=head2 SetTold ISO [TIMETAKEN]
-
-Updates the told and records a transaction
-
-=cut
-
-sub SetTold {
- my $self = shift;
- my $told;
- $told = shift if (@_);
- my $timetaken = shift || 0;
-
- unless ( $self->CurrentUserHasRight('ModifyTicket') ) {
- return ( 0, $self->loc("Permission Denied") );
- }
-
- my $datetold = RT::Date->new( $self->CurrentUser );
- if ($told) {
- $datetold->Set( Format => 'iso',
- Value => $told );
- }
- else {
- $datetold->SetToNow();
- }
-
- return ( $self->_Set( Field => 'Told',
- Value => $datetold->ISO,
- TimeTaken => $timetaken,
- TransactionType => 'Told' ) );
-}
-
-=head2 _SetTold
-
-Updates the told without a transaction or acl check. Useful when we're sending replies.
-
-=cut
-
-sub _SetTold {
- my $self = shift;
-
- my $now = RT::Date->new( $self->CurrentUser );
- $now->SetToNow();
-
- #use __Set to get no ACLs ;)
- return ( $self->__Set( Field => 'Told',
- Value => $now->ISO ) );
-}
-
-=head2 SeenUpTo
-
-
-=cut
-
-sub SeenUpTo {
- my $self = shift;
- my $uid = $self->CurrentUser->id;
- my $attr = $self->FirstAttribute( "User-". $uid ."-SeenUpTo" );
- return if $attr && $attr->Content gt $self->LastUpdated;
-
- my $txns = $self->Transactions;
- $txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
- $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
- $txns->Limit( FIELD => 'Creator', OPERATOR => '!=', VALUE => $uid );
- $txns->Limit(
- FIELD => 'Created',
- OPERATOR => '>',
- VALUE => $attr->Content
- ) if $attr;
- $txns->RowsPerPage(1);
- return $txns->First;
-}
-
-=head2 RanTransactionBatch
-
-Acts as a guard around running TransactionBatch scrips.
-
-Should be false until you enter the code that runs TransactionBatch scrips
-
-Accepts an optional argument to indicate that TransactionBatch Scrips should no longer be run on this object.
-
-=cut
-
-sub RanTransactionBatch {
- my $self = shift;
- my $val = shift;
-
- if ( defined $val ) {
- return $self->{_RanTransactionBatch} = $val;
- } else {
- return $self->{_RanTransactionBatch};
- }
-
-}
-
-
-=head2 TransactionBatch
-
-Returns an array reference of all transactions created on this ticket during
-this ticket object's lifetime or since last application of a batch, or undef
-if there were none.
-
-Only works when the C<UseTransactionBatch> config option is set to true.
-
-=cut
-
-sub TransactionBatch {
- my $self = shift;
- return $self->{_TransactionBatch};
-}
-
-=head2 ApplyTransactionBatch
-
-Applies scrips on the current batch of transactions and shinks it. Usually
-batch is applied when object is destroyed, but in some cases it's too late.
-
-=cut
-
-sub ApplyTransactionBatch {
- my $self = shift;
-
- my $batch = $self->TransactionBatch;
- return unless $batch && @$batch;
-
- $self->_ApplyTransactionBatch;
-
- $self->{_TransactionBatch} = [];
-}
-
-sub _ApplyTransactionBatch {
- my $self = shift;
-
- return if $self->RanTransactionBatch;
- $self->RanTransactionBatch(1);
-
- my $still_exists = RT::Ticket->new( RT->SystemUser );
- $still_exists->Load( $self->Id );
- if (not $still_exists->Id) {
- # The ticket has been removed from the database, but we still
- # have pending TransactionBatch txns for it. Unfortunately,
- # because it isn't in the DB anymore, attempting to run scrips
- # on it may produce unpredictable results; simply drop the
- # batched transactions.
- $RT::Logger->warning("TransactionBatch was fired on a ticket that no longer exists; unable to run scrips! Call ->ApplyTransactionBatch before shredding the ticket, for consistent results.");
- return;
- }
-
- my $batch = $self->TransactionBatch;
-
- my %seen;
- my $types = join ',', grep !$seen{$_}++, grep defined, map $_->__Value('Type'), grep defined, @{$batch};
-
- require RT::Scrips;
- RT::Scrips->new(RT->SystemUser)->Apply(
- Stage => 'TransactionBatch',
- TicketObj => $self,
- TransactionObj => $batch->[0],
- Type => $types,
- );
-
- # Entry point of the rule system
- my $rules = RT::Ruleset->FindAllRules(
- Stage => 'TransactionBatch',
- TicketObj => $self,
- TransactionObj => $batch->[0],
- Type => $types,
- );
- RT::Ruleset->CommitRules($rules);
-}
-
-sub DESTROY {
- my $self = shift;
-
- # DESTROY methods need to localize $@, or it may unset it. This
- # causes $m->abort to not bubble all of the way up. See perlbug
- # http://rt.perl.org/rt3/Ticket/Display.html?id=17650
- local $@;
-
- # The following line eliminates reentrancy.
- # It protects against the fact that perl doesn't deal gracefully
- # when an object's refcount is changed in its destructor.
- return if $self->{_Destroyed}++;
-
- if (in_global_destruction()) {
- unless ($ENV{'HARNESS_ACTIVE'}) {
- warn "Too late to safely run transaction-batch scrips!"
- ." This is typically caused by using ticket objects"
- ." at the top-level of a script which uses the RT API."
- ." Be sure to explicitly undef such ticket objects,"
- ." or put them inside of a lexical scope.";
- }
- return;
- }
-
- return $self->ApplyTransactionBatch;
-}
-
-
-
-
-sub _OverlayAccessible {
- {
- EffectiveId => { 'read' => 1, 'write' => 1, 'public' => 1 },
- Queue => { 'read' => 1, 'write' => 1 },
- Requestors => { 'read' => 1, 'write' => 1 },
- Owner => { 'read' => 1, 'write' => 1 },
- Subject => { 'read' => 1, 'write' => 1 },
- InitialPriority => { 'read' => 1, 'write' => 1 },
- FinalPriority => { 'read' => 1, 'write' => 1 },
- Priority => { 'read' => 1, 'write' => 1 },
- Status => { 'read' => 1, 'write' => 1 },
- TimeEstimated => { 'read' => 1, 'write' => 1 },
- TimeWorked => { 'read' => 1, 'write' => 1 },
- TimeLeft => { 'read' => 1, 'write' => 1 },
- Told => { 'read' => 1, 'write' => 1 },
- Resolved => { 'read' => 1 },
- Type => { 'read' => 1 },
- Starts => { 'read' => 1, 'write' => 1 },
- Started => { 'read' => 1, 'write' => 1 },
- Due => { 'read' => 1, 'write' => 1 },
- Creator => { 'read' => 1, 'auto' => 1 },
- Created => { 'read' => 1, 'auto' => 1 },
- LastUpdatedBy => { 'read' => 1, 'auto' => 1 },
- LastUpdated => { 'read' => 1, 'auto' => 1 }
- };
-
-}
-
-
-
-sub _Set {
- my $self = shift;
-
- my %args = ( Field => undef,
- Value => undef,
- TimeTaken => 0,
- RecordTransaction => 1,
- UpdateTicket => 1,
- CheckACL => 1,
- TransactionType => 'Set',
- @_ );
-
- if ($args{'CheckACL'}) {
- unless ( $self->CurrentUserHasRight('ModifyTicket')) {
- return ( 0, $self->loc("Permission Denied"));
- }
- }
-
- unless ($args{'UpdateTicket'} || $args{'RecordTransaction'}) {
- $RT::Logger->error("Ticket->_Set called without a mandate to record an update or update the ticket");
- return(0, $self->loc("Internal Error"));
- }
-
- #if the user is trying to modify the record
-
- #Take care of the old value we really don't want to get in an ACL loop.
- # so ask the super::_Value
- my $Old = $self->SUPER::_Value("$args{'Field'}");
-
- my ($ret, $msg);
- if ( $args{'UpdateTicket'} ) {
-
- #Set the new value
- ( $ret, $msg ) = $self->SUPER::_Set( Field => $args{'Field'},
- Value => $args{'Value'} );
-
- #If we can't actually set the field to the value, don't record
- # a transaction. instead, get out of here.
- return ( 0, $msg ) unless $ret;
- }
-
- if ( $args{'RecordTransaction'} == 1 ) {
-
- my ( $Trans, $Msg, $TransObj ) = $self->_NewTransaction(
- Type => $args{'TransactionType'},
- Field => $args{'Field'},
- NewValue => $args{'Value'},
- OldValue => $Old,
- TimeTaken => $args{'TimeTaken'},
- );
- # Ensure that we can read the transaction, even if the change
- # just made the ticket unreadable to us
- $TransObj->{ _object_is_readable } = 1;
- return ( $Trans, scalar $TransObj->BriefDescription );
- }
- else {
- return ( $ret, $msg );
- }
-}
-
-
-
-=head2 _Value
-
-Takes the name of a table column.
-Returns its value as a string, if the user passes an ACL check
-
-=cut
-
-sub _Value {
-
- my $self = shift;
- my $field = shift;
-
- #if the field is public, return it.
- if ( $self->_Accessible( $field, 'public' ) ) {
-
- #$RT::Logger->debug("Skipping ACL check for $field");
- return ( $self->SUPER::_Value($field) );
-
- }
-
- #If the current user doesn't have ACLs, don't let em at it.
-
- unless ( $self->CurrentUserHasRight('ShowTicket') ) {
- return (undef);
- }
- return ( $self->SUPER::_Value($field) );
-
-}
-
-
-
-=head2 _UpdateTimeTaken
-
-This routine will increment the timeworked counter. it should
-only be called from _NewTransaction
-
-=cut
-
-sub _UpdateTimeTaken {
- my $self = shift;
- my $Minutes = shift;
- my ($Total);
-
- $Total = $self->SUPER::_Value("TimeWorked");
- $Total = ( $Total || 0 ) + ( $Minutes || 0 );
- $self->SUPER::_Set(
- Field => "TimeWorked",
- Value => $Total
- );
-
- return ($Total);
-}
-
-
-
-
-
-=head2 CurrentUserHasRight
-
- Takes the textual name of a Ticket scoped right (from RT::ACE) and returns
-1 if the user has that right. It returns 0 if the user doesn't have that right.
-
-=cut
-
-sub CurrentUserHasRight {
- my $self = shift;
- my $right = shift;
-
- return $self->CurrentUser->PrincipalObj->HasRight(
- Object => $self,
- Right => $right,
- )
-}
-
-
-=head2 CurrentUserCanSee
-
-Returns true if the current user can see the ticket, using ShowTicket
-
-=cut
-
-sub CurrentUserCanSee {
- my $self = shift;
- return $self->CurrentUserHasRight('ShowTicket');
-}
-
-=head2 HasRight
-
- Takes a paramhash with the attributes 'Right' and 'Principal'
- 'Right' is a ticket-scoped textual right from RT::ACE
- 'Principal' is an RT::User object
-
- Returns 1 if the principal has the right. Returns undef if not.
-
-=cut
-
-sub HasRight {
- my $self = shift;
- my %args = (
- Right => undef,
- Principal => undef,
- @_
- );
-
- unless ( ( defined $args{'Principal'} ) and ( ref( $args{'Principal'} ) ) )
- {
- Carp::cluck("Principal attrib undefined for Ticket::HasRight");
- $RT::Logger->crit("Principal attrib undefined for Ticket::HasRight");
- return(undef);
- }
-
- return (
- $args{'Principal'}->HasRight(
- Object => $self,
- Right => $args{'Right'}
- )
- );
-}
-
-
-
-=head2 Reminders
-
-Return the Reminders object for this ticket. (It's an RT::Reminders object.)
-It isn't acutally a searchbuilder collection itself.
-
-=cut
-
-sub Reminders {
- my $self = shift;
-
- unless ($self->{'__reminders'}) {
- $self->{'__reminders'} = RT::Reminders->new($self->CurrentUser);
- $self->{'__reminders'}->Ticket($self->id);
- }
- return $self->{'__reminders'};
-
-}
-
-
-
-
-=head2 Transactions
-
- Returns an RT::Transactions object of all transactions on this ticket
-
-=cut
-
-sub Transactions {
- my $self = shift;
-
- my $transactions = RT::Transactions->new( $self->CurrentUser );
-
- #If the user has no rights, return an empty object
- if ( $self->CurrentUserHasRight('ShowTicket') ) {
- $transactions->LimitToTicket($self->id);
-
- # if the user may not see comments do not return them
- unless ( $self->CurrentUserHasRight('ShowTicketComments') ) {
- $transactions->Limit(
- SUBCLAUSE => 'acl',
- FIELD => 'Type',
- OPERATOR => '!=',
- VALUE => "Comment"
- );
- $transactions->Limit(
- SUBCLAUSE => 'acl',
- FIELD => 'Type',
- OPERATOR => '!=',
- VALUE => "CommentEmailRecord",
- ENTRYAGGREGATOR => 'AND'
- );
-
- }
- } else {
- $transactions->Limit(
- SUBCLAUSE => 'acl',
- FIELD => 'id',
- VALUE => 0,
- ENTRYAGGREGATOR => 'AND'
- );
- }
-
- return ($transactions);
-}
-
-
-
-
-=head2 TransactionCustomFields
-
- Returns the custom fields that transactions on tickets will have.
-
-=cut
-
-sub TransactionCustomFields {
- my $self = shift;
- my $cfs = $self->QueueObj->TicketTransactionCustomFields;
- $cfs->SetContextObject( $self );
- return $cfs;
-}
-
-
-=head2 LoadCustomFieldByIdentifier
-
-Finds and returns the custom field of the given name for the ticket,
-overriding L<RT::Record/LoadCustomFieldByIdentifier> to look for
-queue-specific CFs before global ones.
-
-=cut
-
-sub LoadCustomFieldByIdentifier {
- my $self = shift;
- my $field = shift;
-
- return $self->SUPER::LoadCustomFieldByIdentifier($field)
- if ref $field or $field =~ /^\d+$/;
-
- my $cf = RT::CustomField->new( $self->CurrentUser );
- $cf->SetContextObject( $self );
- $cf->LoadByNameAndQueue( Name => $field, Queue => $self->Queue );
- $cf->LoadByNameAndQueue( Name => $field, Queue => 0 ) unless $cf->id;
- return $cf;
-}
-
-
-=head2 CustomFieldLookupType
-
-Returns the RT::Ticket lookup type, which can be passed to
-RT::CustomField->Create() via the 'LookupType' hash key.
-
-=cut
-
-
-sub CustomFieldLookupType {
- "RT::Queue-RT::Ticket";
-}
-
-=head2 ACLEquivalenceObjects
-
-This method returns a list of objects for which a user's rights also apply
-to this ticket. Generally, this is only the ticket's queue, but some RT
-extensions may make other objects available too.
-
-This method is called from L<RT::Principal/HasRight>.
-
-=cut
-
-sub ACLEquivalenceObjects {
- my $self = shift;
- return $self->QueueObj;
-
-}
-
-
-1;
-
-=head1 AUTHOR
-
-Jesse Vincent, jesse@bestpractical.com
-
-=head1 SEE ALSO
-
-RT
-
-=cut
-
-
-use RT::Queue;
-use base 'RT::Record';
-
-sub Table {'Tickets'}
-
-
-
-
-
-
-=head2 id
-
-Returns the current value of id.
-(In the database, id is stored as int(11).)
-
-
-=cut
-
-
-=head2 EffectiveId
-
-Returns the current value of EffectiveId.
-(In the database, EffectiveId is stored as int(11).)
-
-
-
-=head2 SetEffectiveId VALUE
-
-
-Set EffectiveId to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, EffectiveId will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Queue
-
-Returns the current value of Queue.
-(In the database, Queue is stored as int(11).)
-
-
-
-=head2 SetQueue VALUE
-
-
-Set Queue to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Queue will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Type
-
-Returns the current value of Type.
-(In the database, Type is stored as varchar(16).)
-
-
-
-=head2 SetType VALUE
-
-
-Set Type to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Type will be stored as a varchar(16).)
-
-
-=cut
-
-
-=head2 IssueStatement
-
-Returns the current value of IssueStatement.
-(In the database, IssueStatement is stored as int(11).)
-
-
-
-=head2 SetIssueStatement VALUE
-
-
-Set IssueStatement to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, IssueStatement will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Resolution
-
-Returns the current value of Resolution.
-(In the database, Resolution is stored as int(11).)
-
-
-
-=head2 SetResolution VALUE
-
-
-Set Resolution to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Resolution will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Owner
-
-Returns the current value of Owner.
-(In the database, Owner is stored as int(11).)
-
-
-
-=head2 SetOwner VALUE
-
-
-Set Owner to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Owner will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Subject
-
-Returns the current value of Subject.
-(In the database, Subject is stored as varchar(200).)
-
-
-
-=head2 SetSubject VALUE
-
-
-Set Subject to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Subject will be stored as a varchar(200).)
-
-
-=cut
-
-
-=head2 InitialPriority
-
-Returns the current value of InitialPriority.
-(In the database, InitialPriority is stored as int(11).)
-
-
-
-=head2 SetInitialPriority VALUE
-
-
-Set InitialPriority to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, InitialPriority will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 FinalPriority
-
-Returns the current value of FinalPriority.
-(In the database, FinalPriority is stored as int(11).)
-
-
-
-=head2 SetFinalPriority VALUE
-
-
-Set FinalPriority to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, FinalPriority will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Priority
-
-Returns the current value of Priority.
-(In the database, Priority is stored as int(11).)
-
-
-
-=head2 SetPriority VALUE
-
-
-Set Priority to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Priority will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 TimeEstimated
-
-Returns the current value of TimeEstimated.
-(In the database, TimeEstimated is stored as int(11).)
-
-
-
-=head2 SetTimeEstimated VALUE
-
-
-Set TimeEstimated to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, TimeEstimated will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 TimeWorked
-
-Returns the current value of TimeWorked.
-(In the database, TimeWorked is stored as int(11).)
-
-
-
-=head2 SetTimeWorked VALUE
-
-
-Set TimeWorked to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, TimeWorked will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Status
-
-Returns the current value of Status.
-(In the database, Status is stored as varchar(64).)
-
-
-
-=head2 SetStatus VALUE
-
-
-Set Status to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Status will be stored as a varchar(64).)
-
-
-=cut
-
-
-=head2 TimeLeft
-
-Returns the current value of TimeLeft.
-(In the database, TimeLeft is stored as int(11).)
-
-
-
-=head2 SetTimeLeft VALUE
-
-
-Set TimeLeft to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, TimeLeft will be stored as a int(11).)
-
-
-=cut
-
-
-=head2 Told
-
-Returns the current value of Told.
-(In the database, Told is stored as datetime.)
-
-
-
-=head2 SetTold VALUE
-
-
-Set Told to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Told will be stored as a datetime.)
-
-
-=cut
-
-
-=head2 Starts
-
-Returns the current value of Starts.
-(In the database, Starts is stored as datetime.)
-
-
-
-=head2 SetStarts VALUE
-
-
-Set Starts to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Starts will be stored as a datetime.)
-
-
-=cut
-
-
-=head2 Started
-
-Returns the current value of Started.
-(In the database, Started is stored as datetime.)
-
-
-
-=head2 SetStarted VALUE
-
-
-Set Started to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Started will be stored as a datetime.)
-
-
-=cut
-
-
-=head2 Due
-
-Returns the current value of Due.
-(In the database, Due is stored as datetime.)
-
-
-
-=head2 SetDue VALUE
-
-
-Set Due to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Due will be stored as a datetime.)
-
-
-=cut
-
-
-=head2 Resolved
-
-Returns the current value of Resolved.
-(In the database, Resolved is stored as datetime.)
-
-
-
-=head2 SetResolved VALUE
-
-
-Set Resolved to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Resolved will be stored as a datetime.)
-
-
-=cut
-
-
-=head2 LastUpdatedBy
-
-Returns the current value of LastUpdatedBy.
-(In the database, LastUpdatedBy is stored as int(11).)
-
-
-=cut
-
-
-=head2 LastUpdated
-
-Returns the current value of LastUpdated.
-(In the database, LastUpdated is stored as datetime.)
-
-
-=cut
-
-
-=head2 Creator
-
-Returns the current value of Creator.
-(In the database, Creator is stored as int(11).)
-
-
-=cut
-
-
-=head2 Created
-
-Returns the current value of Created.
-(In the database, Created is stored as datetime.)
-
-
-=cut
-
-
-=head2 Disabled
-
-Returns the current value of Disabled.
-(In the database, Disabled is stored as smallint(6).)
-
-
-
-=head2 SetDisabled VALUE
-
-
-Set Disabled to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, Disabled will be stored as a smallint(6).)
-
-
-=cut
-
-
-
-sub _CoreAccessible {
- {
-
- id =>
- {read => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => ''},
- EffectiveId =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Queue =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Type =>
- {read => 1, write => 1, sql_type => 12, length => 16, is_blob => 0, is_numeric => 0, type => 'varchar(16)', default => ''},
- IssueStatement =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Resolution =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Owner =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Subject =>
- {read => 1, write => 1, sql_type => 12, length => 200, is_blob => 0, is_numeric => 0, type => 'varchar(200)', default => '[no subject]'},
- InitialPriority =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- FinalPriority =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Priority =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- TimeEstimated =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- TimeWorked =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Status =>
- {read => 1, write => 1, sql_type => 12, length => 64, is_blob => 0, is_numeric => 0, type => 'varchar(64)', default => ''},
- TimeLeft =>
- {read => 1, write => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Told =>
- {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Starts =>
- {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Started =>
- {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Due =>
- {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Resolved =>
- {read => 1, write => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- LastUpdatedBy =>
- {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- LastUpdated =>
- {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Creator =>
- {read => 1, auto => 1, sql_type => 4, length => 11, is_blob => 0, is_numeric => 1, type => 'int(11)', default => '0'},
- Created =>
- {read => 1, auto => 1, sql_type => 11, length => 0, is_blob => 0, is_numeric => 0, type => 'datetime', default => ''},
- Disabled =>
- {read => 1, write => 1, sql_type => 5, length => 6, is_blob => 0, is_numeric => 1, type => 'smallint(6)', default => '0'},
-
- }
-};
-
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-
-# Major Changes:
-
-# - Decimated ProcessRestrictions and broke it into multiple
-# functions joined by a LUT
-# - Semi-Generic SQL stuff moved to another file
-
-# Known Issues: FIXME!
-
-# - ClearRestrictions and Reinitialization is messy and unclear. The
-# only good way to do it is to create a new RT::Tickets object.
-
-=head1 NAME
-
- RT::Tickets - A collection of Ticket objects
-
-
-=head1 SYNOPSIS
-
- use RT::Tickets;
- my $tickets = RT::Tickets->new($CurrentUser);
-
-=head1 DESCRIPTION
-
- A collection of RT::Tickets.
-
-=head1 METHODS
-
-
-=cut
-
-package RT::Tickets;
-
-use strict;
-use warnings;
-
-
-use RT::Ticket;
-
-use base 'RT::SearchBuilder';
-
-sub Table { 'Tickets'}
-
-use RT::CustomFields;
-use DBIx::SearchBuilder::Unique;
-
-# Configuration Tables:
-
-# FIELD_METADATA is a mapping of searchable Field name, to Type, and other
-# metadata.
-
-our %FIELD_METADATA = (
- Status => [ 'ENUM', ], #loc_left_pair
- Queue => [ 'ENUM' => 'Queue', ], #loc_left_pair
- Type => [ 'ENUM', ], #loc_left_pair
- Creator => [ 'ENUM' => 'User', ], #loc_left_pair
- LastUpdatedBy => [ 'ENUM' => 'User', ], #loc_left_pair
- Owner => [ 'WATCHERFIELD' => 'Owner', ], #loc_left_pair
- EffectiveId => [ 'INT', ], #loc_left_pair
- id => [ 'ID', ], #loc_left_pair
- InitialPriority => [ 'INT', ], #loc_left_pair
- FinalPriority => [ 'INT', ], #loc_left_pair
- Priority => [ 'INT', ], #loc_left_pair
- TimeLeft => [ 'INT', ], #loc_left_pair
- TimeWorked => [ 'INT', ], #loc_left_pair
- TimeEstimated => [ 'INT', ], #loc_left_pair
-
- Linked => [ 'LINK' ], #loc_left_pair
- LinkedTo => [ 'LINK' => 'To' ], #loc_left_pair
- LinkedFrom => [ 'LINK' => 'From' ], #loc_left_pair
- MemberOf => [ 'LINK' => To => 'MemberOf', ], #loc_left_pair
- DependsOn => [ 'LINK' => To => 'DependsOn', ], #loc_left_pair
- RefersTo => [ 'LINK' => To => 'RefersTo', ], #loc_left_pair
- HasMember => [ 'LINK' => From => 'MemberOf', ], #loc_left_pair
- DependentOn => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair
- DependedOnBy => [ 'LINK' => From => 'DependsOn', ], #loc_left_pair
- ReferredToBy => [ 'LINK' => From => 'RefersTo', ], #loc_left_pair
- Told => [ 'DATE' => 'Told', ], #loc_left_pair
- Starts => [ 'DATE' => 'Starts', ], #loc_left_pair
- Started => [ 'DATE' => 'Started', ], #loc_left_pair
- Due => [ 'DATE' => 'Due', ], #loc_left_pair
- Resolved => [ 'DATE' => 'Resolved', ], #loc_left_pair
- LastUpdated => [ 'DATE' => 'LastUpdated', ], #loc_left_pair
- Created => [ 'DATE' => 'Created', ], #loc_left_pair
- Subject => [ 'STRING', ], #loc_left_pair
- Content => [ 'TRANSCONTENT', ], #loc_left_pair
- ContentType => [ 'TRANSFIELD', ], #loc_left_pair
- Filename => [ 'TRANSFIELD', ], #loc_left_pair
- TransactionDate => [ 'TRANSDATE', ], #loc_left_pair
- Requestor => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair
- Requestors => [ 'WATCHERFIELD' => 'Requestor', ], #loc_left_pair
- Cc => [ 'WATCHERFIELD' => 'Cc', ], #loc_left_pair
- AdminCc => [ 'WATCHERFIELD' => 'AdminCc', ], #loc_left_pair
- Watcher => [ 'WATCHERFIELD', ], #loc_left_pair
- QueueCc => [ 'WATCHERFIELD' => 'Cc' => 'Queue', ], #loc_left_pair
- QueueAdminCc => [ 'WATCHERFIELD' => 'AdminCc' => 'Queue', ], #loc_left_pair
- QueueWatcher => [ 'WATCHERFIELD' => undef => 'Queue', ], #loc_left_pair
- CustomFieldValue => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair
- CustomField => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair
- CF => [ 'CUSTOMFIELD' => 'Ticket' ], #loc_left_pair
- Updated => [ 'TRANSDATE', ], #loc_left_pair
- RequestorGroup => [ 'MEMBERSHIPFIELD' => 'Requestor', ], #loc_left_pair
- CCGroup => [ 'MEMBERSHIPFIELD' => 'Cc', ], #loc_left_pair
- AdminCCGroup => [ 'MEMBERSHIPFIELD' => 'AdminCc', ], #loc_left_pair
- WatcherGroup => [ 'MEMBERSHIPFIELD', ], #loc_left_pair
- HasAttribute => [ 'HASATTRIBUTE', 1 ],
- HasNoAttribute => [ 'HASATTRIBUTE', 0 ],
- #freeside
- Customer => [ 'FREESIDEFIELD' => 'Customer' ],
- Service => [ 'FREESIDEFIELD' => 'Service' ],
- WillResolve => [ 'DATE' => 'WillResolve', ], #loc_left_pair
-);
-
-# Lower Case version of FIELDS, for case insensitivity
-our %LOWER_CASE_FIELDS = map { ( lc($_) => $_ ) } (keys %FIELD_METADATA);
-
-our %SEARCHABLE_SUBFIELDS = (
- User => [qw(
- EmailAddress Name RealName Nickname Organization Address1 Address2
- WorkPhone HomePhone MobilePhone PagerPhone id
- )],
-);
-
-# Mapping of Field Type to Function
-our %dispatch = (
- ENUM => \&_EnumLimit,
- INT => \&_IntLimit,
- ID => \&_IdLimit,
- LINK => \&_LinkLimit,
- DATE => \&_DateLimit,
- STRING => \&_StringLimit,
- TRANSFIELD => \&_TransLimit,
- TRANSCONTENT => \&_TransContentLimit,
- TRANSDATE => \&_TransDateLimit,
- WATCHERFIELD => \&_WatcherLimit,
- MEMBERSHIPFIELD => \&_WatcherMembershipLimit,
- CUSTOMFIELD => \&_CustomFieldLimit,
- HASATTRIBUTE => \&_HasAttributeLimit,
- FREESIDEFIELD => \&_FreesideFieldLimit,
-);
-our %can_bundle = ();# WATCHERFIELD => "yes", );
-
-# Default EntryAggregator per type
-# if you specify OP, you must specify all valid OPs
-my %DefaultEA = (
- INT => 'AND',
- ENUM => {
- '=' => 'OR',
- '!=' => 'AND'
- },
- DATE => {
- '=' => 'OR',
- '>=' => 'AND',
- '<=' => 'AND',
- '>' => 'AND',
- '<' => 'AND'
- },
- STRING => {
- '=' => 'OR',
- '!=' => 'AND',
- 'LIKE' => 'AND',
- 'NOT LIKE' => 'AND'
- },
- TRANSFIELD => 'AND',
- TRANSDATE => 'AND',
- LINK => 'OR',
- LINKFIELD => 'AND',
- TARGET => 'AND',
- BASE => 'AND',
- WATCHERFIELD => {
- '=' => 'OR',
- '!=' => 'AND',
- 'LIKE' => 'OR',
- 'NOT LIKE' => 'AND'
- },
-
- HASATTRIBUTE => {
- '=' => 'AND',
- '!=' => 'AND',
- },
-
- CUSTOMFIELD => 'OR',
-);
-
-# Helper functions for passing the above lexically scoped tables above
-# into Tickets_SQL.
-sub FIELDS { return \%FIELD_METADATA }
-sub dispatch { return \%dispatch }
-sub can_bundle { return \%can_bundle }
-
-# Bring in the clowns.
-require RT::Tickets_SQL;
-
-
-our @SORTFIELDS = qw(id Status
- Queue Subject
- Owner Created Due Starts Started
- Told
- Resolved LastUpdated Priority TimeWorked TimeLeft);
-
-=head2 SortFields
-
-Returns the list of fields that lists of tickets can easily be sorted by
-
-=cut
-
-sub SortFields {
- my $self = shift;
- return (@SORTFIELDS);
-}
-
-
-# BEGIN SQL STUFF *********************************
-
-
-sub CleanSlate {
- my $self = shift;
- $self->SUPER::CleanSlate( @_ );
- delete $self->{$_} foreach qw(
- _sql_cf_alias
- _sql_group_members_aliases
- _sql_object_cfv_alias
- _sql_role_group_aliases
- _sql_trattachalias
- _sql_u_watchers_alias_for_sort
- _sql_u_watchers_aliases
- _sql_current_user_can_see_applied
- );
-}
-
-=head1 Limit Helper Routines
-
-These routines are the targets of a dispatch table depending on the
-type of field. They all share the same signature:
-
- my ($self,$field,$op,$value,@rest) = @_;
-
-The values in @rest should be suitable for passing directly to
-DBIx::SearchBuilder::Limit.
-
-Essentially they are an expanded/broken out (and much simplified)
-version of what ProcessRestrictions used to do. They're also much
-more clearly delineated by the TYPE of field being processed.
-
-=head2 _IdLimit
-
-Handle ID field.
-
-=cut
-
-sub _IdLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- if ( $value eq '__Bookmarked__' ) {
- return $sb->_BookmarkLimit( $field, $op, $value, @rest );
- } else {
- return $sb->_IntLimit( $field, $op, $value, @rest );
- }
-}
-
-sub _BookmarkLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- die "Invalid operator $op for __Bookmarked__ search on $field"
- unless $op =~ /^(=|!=)$/;
-
- my @bookmarks = do {
- my $tmp = $sb->CurrentUser->UserObj->FirstAttribute('Bookmarks');
- $tmp = $tmp->Content if $tmp;
- $tmp ||= {};
- grep $_, keys %$tmp;
- };
-
- return $sb->_SQLLimit(
- FIELD => $field,
- OPERATOR => $op,
- VALUE => 0,
- @rest,
- ) unless @bookmarks;
-
- # as bookmarked tickets can be merged we have to use a join
- # but it should be pretty lightweight
- my $tickets_alias = $sb->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Tickets',
- FIELD2 => 'EffectiveId',
- );
- $sb->_OpenParen;
- my $first = 1;
- my $ea = $op eq '='? 'OR': 'AND';
- foreach my $id ( sort @bookmarks ) {
- $sb->_SQLLimit(
- ALIAS => $tickets_alias,
- FIELD => 'id',
- OPERATOR => $op,
- VALUE => $id,
- $first? (@rest): ( ENTRYAGGREGATOR => $ea )
- );
- $first = 0 if $first;
- }
- $sb->_CloseParen;
-}
-
-=head2 _EnumLimit
-
-Handle Fields which are limited to certain values, and potentially
-need to be looked up from another class.
-
-This subroutine actually handles two different kinds of fields. For
-some the user is responsible for limiting the values. (i.e. Status,
-Type).
-
-For others, the value specified by the user will be looked by via
-specified class.
-
-Meta Data:
- name of class to lookup in (Optional)
-
-=cut
-
-sub _EnumLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- # SQL::Statement changes != to <>. (Can we remove this now?)
- $op = "!=" if $op eq "<>";
-
- die "Invalid Operation: $op for $field"
- unless $op eq "="
- or $op eq "!=";
-
- my $meta = $FIELD_METADATA{$field};
- if ( defined $meta->[1] && defined $value && $value !~ /^\d+$/ ) {
- my $class = "RT::" . $meta->[1];
- my $o = $class->new( $sb->CurrentUser );
- $o->Load($value);
- $value = $o->Id || 0;
- } elsif ( $field eq "Type" ) {
- $value = lc $value if $value =~ /^(ticket|approval|reminder)$/i;
- } elsif ($field eq "Status") {
- $value = lc $value;
- }
- $sb->_SQLLimit(
- FIELD => $field,
- VALUE => $value,
- OPERATOR => $op,
- @rest,
- );
-}
-
-=head2 _IntLimit
-
-Handle fields where the values are limited to integers. (For example,
-Priority, TimeWorked.)
-
-Meta Data:
- None
-
-=cut
-
-sub _IntLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- die "Invalid Operator $op for $field"
- unless $op =~ /^(=|!=|>|<|>=|<=)$/;
-
- $sb->_SQLLimit(
- FIELD => $field,
- VALUE => $value,
- OPERATOR => $op,
- @rest,
- );
-}
-
-=head2 _LinkLimit
-
-Handle fields which deal with links between tickets. (MemberOf, DependsOn)
-
-Meta Data:
- 1: Direction (From, To)
- 2: Link Type (MemberOf, DependsOn, RefersTo)
-
-=cut
-
-sub _LinkLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- my $meta = $FIELD_METADATA{$field};
- die "Invalid Operator $op for $field" unless $op =~ /^(=|!=|IS|IS NOT)$/io;
-
- my $is_negative = 0;
- if ( $op eq '!=' || $op =~ /\bNOT\b/i ) {
- $is_negative = 1;
- }
- my $is_null = 0;
- $is_null = 1 if !$value || $value =~ /^null$/io;
-
- my $direction = $meta->[1] || '';
- my ($matchfield, $linkfield) = ('', '');
- if ( $direction eq 'To' ) {
- ($matchfield, $linkfield) = ("Target", "Base");
- }
- elsif ( $direction eq 'From' ) {
- ($matchfield, $linkfield) = ("Base", "Target");
- }
- elsif ( $direction ) {
- die "Invalid link direction '$direction' for $field\n";
- } else {
- $sb->_OpenParen;
- $sb->_LinkLimit( 'LinkedTo', $op, $value, @rest );
- $sb->_LinkLimit(
- 'LinkedFrom', $op, $value, @rest,
- ENTRYAGGREGATOR => (($is_negative && $is_null) || (!$is_null && !$is_negative))? 'OR': 'AND',
- );
- $sb->_CloseParen;
- return;
- }
-
- my $is_local = 1;
- if ( $is_null ) {
- $op = ($op =~ /^(=|IS)$/i)? 'IS': 'IS NOT';
- }
- elsif ( $value =~ /\D/ ) {
- $value = RT::URI->new( $sb->CurrentUser )->CanonicalizeURI( $value );
- $is_local = 0;
- }
- $matchfield = "Local$matchfield" if $is_local;
-
-#For doing a left join to find "unlinked tickets" we want to generate a query that looks like this
-# SELECT main.* FROM Tickets main
-# LEFT JOIN Links Links_1 ON ( (Links_1.Type = 'MemberOf')
-# AND(main.id = Links_1.LocalTarget))
-# WHERE Links_1.LocalBase IS NULL;
-
- if ( $is_null ) {
- my $linkalias = $sb->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Links',
- FIELD2 => 'Local' . $linkfield
- );
- $sb->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Type',
- OPERATOR => '=',
- VALUE => $meta->[2],
- ) if $meta->[2];
- $sb->_SQLLimit(
- @rest,
- ALIAS => $linkalias,
- FIELD => $matchfield,
- OPERATOR => $op,
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- );
- }
- else {
- my $linkalias = $sb->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Links',
- FIELD2 => 'Local' . $linkfield
- );
- $sb->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Type',
- OPERATOR => '=',
- VALUE => $meta->[2],
- ) if $meta->[2];
- $sb->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => $matchfield,
- OPERATOR => '=',
- VALUE => $value,
- );
- $sb->_SQLLimit(
- @rest,
- ALIAS => $linkalias,
- FIELD => $matchfield,
- OPERATOR => $is_negative? 'IS': 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- );
- }
-}
-
-=head2 _DateLimit
-
-Handle date fields. (Created, LastTold..)
-
-Meta Data:
- 1: type of link. (Probably not necessary.)
-
-=cut
-
-sub _DateLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- die "Invalid Date Op: $op"
- unless $op =~ /^(=|>|<|>=|<=)$/;
-
- my $meta = $FIELD_METADATA{$field};
- die "Incorrect Meta Data for $field"
- unless ( defined $meta->[1] );
-
- $sb->_DateFieldLimit( $meta->[1], $op, $value, @rest );
-}
-
-# Factor this out for use by custom fields
-
-sub _DateFieldLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- my $date = RT::Date->new( $sb->CurrentUser );
- $date->Set( Format => 'unknown', Value => $value );
-
- if ( $op eq "=" ) {
-
- # if we're specifying =, that means we want everything on a
- # particular single day. in the database, we need to check for >
- # and < the edges of that day.
- #
- # Except if the value is 'this month' or 'last month', check
- # > and < the edges of the month.
-
- my ($daystart, $dayend);
- if ( lc($value) eq 'this month' ) {
- $date->SetToNow;
- $date->SetToStart('month', Timezone => 'server');
- $daystart = $date->ISO;
- $date->AddMonth(Timezone => 'server');
- $dayend = $date->ISO;
- }
- elsif ( lc($value) eq 'last month' ) {
- $date->SetToNow;
- $date->SetToStart('month', Timezone => 'server');
- $dayend = $date->ISO;
- $date->AddDays(-1);
- $date->SetToStart('month', Timezone => 'server');
- $daystart = $date->ISO;
- }
- else {
- $date->SetToMidnight( Timezone => 'server' );
- $daystart = $date->ISO;
- $date->AddDay;
- $dayend = $date->ISO;
- }
-
- $sb->_OpenParen;
-
- $sb->_SQLLimit(
- FIELD => $field,
- OPERATOR => ">=",
- VALUE => $daystart,
- @rest,
- );
-
- $sb->_SQLLimit(
- FIELD => $field,
- OPERATOR => "<",
- VALUE => $dayend,
- @rest,
- ENTRYAGGREGATOR => 'AND',
- );
-
- $sb->_CloseParen;
-
- }
- else {
- $sb->_SQLLimit(
- FIELD => $field,
- OPERATOR => $op,
- VALUE => $date->ISO,
- @rest,
- );
- }
-}
-
-=head2 _StringLimit
-
-Handle simple fields which are just strings. (Subject,Type)
-
-Meta Data:
- None
-
-=cut
-
-sub _StringLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- # FIXME:
- # Valid Operators:
- # =, !=, LIKE, NOT LIKE
- if ( RT->Config->Get('DatabaseType') eq 'Oracle'
- && (!defined $value || !length $value)
- && lc($op) ne 'is' && lc($op) ne 'is not'
- ) {
- if ($op eq '!=' || $op =~ /^NOT\s/i) {
- $op = 'IS NOT';
- } else {
- $op = 'IS';
- }
- $value = 'NULL';
- }
-
- $sb->_SQLLimit(
- FIELD => $field,
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- @rest,
- );
-}
-
-=head2 _TransDateLimit
-
-Handle fields limiting based on Transaction Date.
-
-The inpupt value must be in a format parseable by Time::ParseDate
-
-Meta Data:
- None
-
-=cut
-
-# This routine should really be factored into translimit.
-sub _TransDateLimit {
- my ( $sb, $field, $op, $value, @rest ) = @_;
-
- # See the comments for TransLimit, they apply here too
-
- my $txn_alias = $sb->JoinTransactions;
-
- my $date = RT::Date->new( $sb->CurrentUser );
- $date->Set( Format => 'unknown', Value => $value );
-
- $sb->_OpenParen;
- if ( $op eq "=" ) {
-
- # if we're specifying =, that means we want everything on a
- # particular single day. in the database, we need to check for >
- # and < the edges of that day.
-
- $date->SetToMidnight( Timezone => 'server' );
- my $daystart = $date->ISO;
- $date->AddDay;
- my $dayend = $date->ISO;
-
- $sb->_SQLLimit(
- ALIAS => $txn_alias,
- FIELD => 'Created',
- OPERATOR => ">=",
- VALUE => $daystart,
- @rest
- );
- $sb->_SQLLimit(
- ALIAS => $txn_alias,
- FIELD => 'Created',
- OPERATOR => "<=",
- VALUE => $dayend,
- @rest,
- ENTRYAGGREGATOR => 'AND',
- );
-
- }
-
- # not searching for a single day
- else {
-
- #Search for the right field
- $sb->_SQLLimit(
- ALIAS => $txn_alias,
- FIELD => 'Created',
- OPERATOR => $op,
- VALUE => $date->ISO,
- @rest
- );
- }
-
- $sb->_CloseParen;
-}
-
-=head2 _TransLimit
-
-Limit based on the ContentType or the Filename of a transaction.
-
-=cut
-
-sub _TransLimit {
- my ( $self, $field, $op, $value, %rest ) = @_;
-
- my $txn_alias = $self->JoinTransactions;
- unless ( defined $self->{_sql_trattachalias} ) {
- $self->{_sql_trattachalias} = $self->_SQLJoin(
- TYPE => 'LEFT', # not all txns have an attachment
- ALIAS1 => $txn_alias,
- FIELD1 => 'id',
- TABLE2 => 'Attachments',
- FIELD2 => 'TransactionId',
- );
- }
-
- $self->_SQLLimit(
- %rest,
- ALIAS => $self->{_sql_trattachalias},
- FIELD => $field,
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- );
-}
-
-=head2 _TransContentLimit
-
-Limit based on the Content of a transaction.
-
-=cut
-
-sub _TransContentLimit {
-
- # Content search
-
- # If only this was this simple. We've got to do something
- # complicated here:
-
- #Basically, we want to make sure that the limits apply to
- #the same attachment, rather than just another attachment
- #for the same ticket, no matter how many clauses we lump
- #on. We put them in TicketAliases so that they get nuked
- #when we redo the join.
-
- # In the SQL, we might have
- # (( Content = foo ) or ( Content = bar AND Content = baz ))
- # The AND group should share the same Alias.
-
- # Actually, maybe it doesn't matter. We use the same alias and it
- # works itself out? (er.. different.)
-
- # Steal more from _ProcessRestrictions
-
- # FIXME: Maybe look at the previous FooLimit call, and if it was a
- # TransLimit and EntryAggregator == AND, reuse the Aliases?
-
- # Or better - store the aliases on a per subclause basis - since
- # those are going to be the things we want to relate to each other,
- # anyway.
-
- # maybe we should not allow certain kinds of aggregation of these
- # clauses and do a psuedo regex instead? - the problem is getting
- # them all into the same subclause when you have (A op B op C) - the
- # way they get parsed in the tree they're in different subclauses.
-
- my ( $self, $field, $op, $value, %rest ) = @_;
- $field = 'Content' if $field =~ /\W/;
-
- my $config = RT->Config->Get('FullTextSearch') || {};
- unless ( $config->{'Enable'} ) {
- $self->_SQLLimit( %rest, FIELD => 'id', VALUE => 0 );
- return;
- }
-
- my $txn_alias = $self->JoinTransactions;
- unless ( defined $self->{_sql_trattachalias} ) {
- $self->{_sql_trattachalias} = $self->_SQLJoin(
- TYPE => 'LEFT', # not all txns have an attachment
- ALIAS1 => $txn_alias,
- FIELD1 => 'id',
- TABLE2 => 'Attachments',
- FIELD2 => 'TransactionId',
- );
- }
-
- $self->_OpenParen;
- if ( $config->{'Indexed'} ) {
- my $db_type = RT->Config->Get('DatabaseType');
-
- my $alias;
- if ( $config->{'Table'} and $config->{'Table'} ne "Attachments") {
- $alias = $self->{'_sql_aliases'}{'full_text'} ||= $self->_SQLJoin(
- TYPE => 'LEFT',
- ALIAS1 => $self->{'_sql_trattachalias'},
- FIELD1 => 'id',
- TABLE2 => $config->{'Table'},
- FIELD2 => 'id',
- );
- } else {
- $alias = $self->{'_sql_trattachalias'};
- }
-
- #XXX: handle negative searches
- my $index = $config->{'Column'};
- if ( $db_type eq 'Oracle' ) {
- my $dbh = $RT::Handle->dbh;
- my $alias = $self->{_sql_trattachalias};
- $self->_SQLLimit(
- %rest,
- FUNCTION => "CONTAINS( $alias.$field, ".$dbh->quote($value) .")",
- OPERATOR => '>',
- VALUE => 0,
- QUOTEVALUE => 0,
- CASESENSITIVE => 1,
- );
- # this is required to trick DBIx::SB's LEFT JOINS optimizer
- # into deciding that join is redundant as it is
- $self->_SQLLimit(
- ENTRYAGGREGATOR => 'AND',
- ALIAS => $self->{_sql_trattachalias},
- FIELD => 'Content',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- );
- }
- elsif ( $db_type eq 'Pg' ) {
- my $dbh = $RT::Handle->dbh;
- $self->_SQLLimit(
- %rest,
- ALIAS => $alias,
- FIELD => $index,
- OPERATOR => '@@',
- VALUE => 'plainto_tsquery('. $dbh->quote($value) .')',
- QUOTEVALUE => 0,
- );
- }
- elsif ( $db_type eq 'mysql' ) {
- # XXX: We could theoretically skip the join to Attachments,
- # and have Sphinx simply index and group by the TicketId,
- # and join Ticket.id to that attribute, which would be much
- # more efficient -- however, this is only a possibility if
- # there are no other transaction limits.
-
- # This is a special character. Note that \ does not escape
- # itself (in Sphinx 2.1.0, at least), so 'foo\;bar' becoming
- # 'foo\\;bar' is not a vulnerability, and is still parsed as
- # "foo, \, ;, then bar". Happily, the default mode is
- # "all", meaning that boolean operators are not special.
- $value =~ s/;/\\;/g;
-
- my $max = $config->{'MaxMatches'};
- $self->_SQLLimit(
- %rest,
- ALIAS => $alias,
- FIELD => 'query',
- OPERATOR => '=',
- VALUE => "$value;limit=$max;maxmatches=$max",
- );
- }
- } else {
- $self->_SQLLimit(
- %rest,
- ALIAS => $self->{_sql_trattachalias},
- FIELD => $field,
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- );
- }
- if ( RT->Config->Get('DontSearchFileAttachments') ) {
- $self->_SQLLimit(
- ENTRYAGGREGATOR => 'AND',
- ALIAS => $self->{_sql_trattachalias},
- FIELD => 'Filename',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- );
- }
- $self->_CloseParen;
-}
-
-=head2 _WatcherLimit
-
-Handle watcher limits. (Requestor, CC, etc..)
-
-Meta Data:
- 1: Field to query on
-
-
-
-=cut
-
-sub _WatcherLimit {
- my $self = shift;
- my $field = shift;
- my $op = shift;
- my $value = shift;
- my %rest = (@_);
-
- my $meta = $FIELD_METADATA{ $field };
- my $type = $meta->[1] || '';
- my $class = $meta->[2] || 'Ticket';
-
- # Bail if the subfield is not allowed
- if ( $rest{SUBKEY}
- and not grep { $_ eq $rest{SUBKEY} } @{$SEARCHABLE_SUBFIELDS{'User'}})
- {
- die "Invalid watcher subfield: '$rest{SUBKEY}'";
- }
-
- # if it's equality op and search by Email or Name then we can preload user
- # we do it to help some DBs better estimate number of rows and get better plans
- if ( $op =~ /^!?=$/ && (!$rest{'SUBKEY'} || $rest{'SUBKEY'} eq 'Name' || $rest{'SUBKEY'} eq 'EmailAddress') ) {
- my $o = RT::User->new( $self->CurrentUser );
- my $method =
- !$rest{'SUBKEY'}
- ? $field eq 'Owner'? 'Load' : 'LoadByEmail'
- : $rest{'SUBKEY'} eq 'EmailAddress' ? 'LoadByEmail': 'Load';
- $o->$method( $value );
- $rest{'SUBKEY'} = 'id';
- $value = $o->id || 0;
- }
-
- # Owner was ENUM field, so "Owner = 'xxx'" allowed user to
- # search by id and Name at the same time, this is workaround
- # to preserve backward compatibility
- if ( $field eq 'Owner' ) {
- if ( ($rest{'SUBKEY'}||'') eq 'id' ) {
- $self->_SQLLimit(
- FIELD => 'Owner',
- OPERATOR => $op,
- VALUE => $value,
- %rest,
- );
- return;
- }
- }
- $rest{SUBKEY} ||= 'EmailAddress';
-
- my ($groups, $group_members, $users);
- if ( $rest{'BUNDLE'} ) {
- ($groups, $group_members, $users) = @{ $rest{'BUNDLE'} };
- } else {
- $groups = $self->_RoleGroupsJoin( Type => $type, Class => $class, New => !$type );
- }
-
- $self->_OpenParen;
- if ( $op =~ /^IS(?: NOT)?$/i ) {
- # is [not] empty case
-
- $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups );
- # to avoid joining the table Users into the query, we just join GM
- # and make sure we don't match records where group is member of itself
- $self->SUPER::Limit(
- LEFTJOIN => $group_members,
- FIELD => 'GroupId',
- OPERATOR => '!=',
- VALUE => "$group_members.MemberId",
- QUOTEVALUE => 0,
- );
- $self->_SQLLimit(
- ALIAS => $group_members,
- FIELD => 'GroupId',
- OPERATOR => $op,
- VALUE => $value,
- %rest,
- );
- }
- elsif ( $op =~ /^!=$|^NOT\s+/i ) {
- # negative condition case
-
- # reverse op
- $op =~ s/!|NOT\s+//i;
-
- # XXX: we have no way to build correct "Watcher.X != 'Y'" when condition
- # "X = 'Y'" matches more then one user so we try to fetch two records and
- # do the right thing when there is only one exist and semi-working solution
- # otherwise.
- my $users_obj = RT::Users->new( $self->CurrentUser );
- $users_obj->Limit(
- FIELD => $rest{SUBKEY},
- OPERATOR => $op,
- VALUE => $value,
- );
- $users_obj->OrderBy;
- $users_obj->RowsPerPage(2);
- my @users = @{ $users_obj->ItemsArrayRef };
-
- $group_members ||= $self->_GroupMembersJoin( GroupsAlias => $groups );
- if ( @users <= 1 ) {
- my $uid = 0;
- $uid = $users[0]->id if @users;
- $self->SUPER::Limit(
- LEFTJOIN => $group_members,
- ALIAS => $group_members,
- FIELD => 'MemberId',
- VALUE => $uid,
- );
- $self->_SQLLimit(
- %rest,
- ALIAS => $group_members,
- FIELD => 'id',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- );
- } else {
- $self->SUPER::Limit(
- LEFTJOIN => $group_members,
- FIELD => 'GroupId',
- OPERATOR => '!=',
- VALUE => "$group_members.MemberId",
- QUOTEVALUE => 0,
- );
- $users ||= $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $group_members,
- FIELD1 => 'MemberId',
- TABLE2 => 'Users',
- FIELD2 => 'id',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $users,
- ALIAS => $users,
- FIELD => $rest{SUBKEY},
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- );
- $self->_SQLLimit(
- %rest,
- ALIAS => $users,
- FIELD => 'id',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- );
- }
- } else {
- # positive condition case
-
- $group_members ||= $self->_GroupMembersJoin(
- GroupsAlias => $groups, New => 1, Left => 0
- );
- $users ||= $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $group_members,
- FIELD1 => 'MemberId',
- TABLE2 => 'Users',
- FIELD2 => 'id',
- );
- $self->_SQLLimit(
- %rest,
- ALIAS => $users,
- FIELD => $rest{'SUBKEY'},
- VALUE => $value,
- OPERATOR => $op,
- CASESENSITIVE => 0,
- );
- }
- $self->_CloseParen;
- return ($groups, $group_members, $users);
-}
-
-sub _RoleGroupsJoin {
- my $self = shift;
- my %args = (New => 0, Class => 'Ticket', Type => '', @_);
- return $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} }
- if $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} }
- && !$args{'New'};
-
- # we always have watcher groups for ticket, so we use INNER join
- my $groups = $self->Join(
- ALIAS1 => 'main',
- FIELD1 => $args{'Class'} eq 'Queue'? 'Queue': 'id',
- TABLE2 => 'Groups',
- FIELD2 => 'Instance',
- ENTRYAGGREGATOR => 'AND',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $groups,
- ALIAS => $groups,
- FIELD => 'Domain',
- VALUE => 'RT::'. $args{'Class'} .'-Role',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $groups,
- ALIAS => $groups,
- FIELD => 'Type',
- VALUE => $args{'Type'},
- ) if $args{'Type'};
-
- $self->{'_sql_role_group_aliases'}{ $args{'Class'} .'-'. $args{'Type'} } = $groups
- unless $args{'New'};
-
- return $groups;
-}
-
-sub _GroupMembersJoin {
- my $self = shift;
- my %args = (New => 1, GroupsAlias => undef, Left => 1, @_);
-
- return $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} }
- if $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} }
- && !$args{'New'};
-
- my $alias = $self->Join(
- $args{'Left'} ? (TYPE => 'LEFT') : (),
- ALIAS1 => $args{'GroupsAlias'},
- FIELD1 => 'id',
- TABLE2 => 'CachedGroupMembers',
- FIELD2 => 'GroupId',
- ENTRYAGGREGATOR => 'AND',
- );
- $self->SUPER::Limit(
- $args{'Left'} ? (LEFTJOIN => $alias) : (),
- ALIAS => $alias,
- FIELD => 'Disabled',
- VALUE => 0,
- );
-
- $self->{'_sql_group_members_aliases'}{ $args{'GroupsAlias'} } = $alias
- unless $args{'New'};
-
- return $alias;
-}
-
-=head2 _WatcherJoin
-
-Helper function which provides joins to a watchers table both for limits
-and for ordering.
-
-=cut
-
-sub _WatcherJoin {
- my $self = shift;
- my $type = shift || '';
-
-
- my $groups = $self->_RoleGroupsJoin( Type => $type );
- my $group_members = $self->_GroupMembersJoin( GroupsAlias => $groups );
- # XXX: work around, we must hide groups that
- # are members of the role group we search in,
- # otherwise them result in wrong NULLs in Users
- # table and break ordering. Now, we know that
- # RT doesn't allow to add groups as members of the
- # ticket roles, so we just hide entries in CGM table
- # with MemberId == GroupId from results
- $self->SUPER::Limit(
- LEFTJOIN => $group_members,
- FIELD => 'GroupId',
- OPERATOR => '!=',
- VALUE => "$group_members.MemberId",
- QUOTEVALUE => 0,
- );
- my $users = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $group_members,
- FIELD1 => 'MemberId',
- TABLE2 => 'Users',
- FIELD2 => 'id',
- );
- return ($groups, $group_members, $users);
-}
-
-=head2 _WatcherMembershipLimit
-
-Handle watcher membership limits, i.e. whether the watcher belongs to a
-specific group or not.
-
-Meta Data:
- 1: Field to query on
-
-SELECT DISTINCT main.*
-FROM
- Tickets main,
- Groups Groups_1,
- CachedGroupMembers CachedGroupMembers_2,
- Users Users_3
-WHERE (
- (main.EffectiveId = main.id)
-) AND (
- (main.Status != 'deleted')
-) AND (
- (main.Type = 'ticket')
-) AND (
- (
- (Users_3.EmailAddress = '22')
- AND
- (Groups_1.Domain = 'RT::Ticket-Role')
- AND
- (Groups_1.Type = 'RequestorGroup')
- )
-) AND
- Groups_1.Instance = main.id
-AND
- Groups_1.id = CachedGroupMembers_2.GroupId
-AND
- CachedGroupMembers_2.MemberId = Users_3.id
-ORDER BY main.id ASC
-LIMIT 25
-
-=cut
-
-sub _WatcherMembershipLimit {
- my ( $self, $field, $op, $value, @rest ) = @_;
- my %rest = @rest;
-
- $self->_OpenParen;
-
- my $groups = $self->NewAlias('Groups');
- my $groupmembers = $self->NewAlias('CachedGroupMembers');
- my $users = $self->NewAlias('Users');
- my $memberships = $self->NewAlias('CachedGroupMembers');
-
- if ( ref $field ) { # gross hack
- my @bundle = @$field;
- $self->_OpenParen;
- for my $chunk (@bundle) {
- ( $field, $op, $value, @rest ) = @$chunk;
- $self->_SQLLimit(
- ALIAS => $memberships,
- FIELD => 'GroupId',
- VALUE => $value,
- OPERATOR => $op,
- @rest,
- );
- }
- $self->_CloseParen;
- }
- else {
- $self->_SQLLimit(
- ALIAS => $memberships,
- FIELD => 'GroupId',
- VALUE => $value,
- OPERATOR => $op,
- @rest,
- );
- }
-
- # Tie to groups for tickets we care about
- $self->_SQLLimit(
- ALIAS => $groups,
- FIELD => 'Domain',
- VALUE => 'RT::Ticket-Role',
- ENTRYAGGREGATOR => 'AND'
- );
-
- $self->Join(
- ALIAS1 => $groups,
- FIELD1 => 'Instance',
- ALIAS2 => 'main',
- FIELD2 => 'id'
- );
-
- # }}}
-
- # If we care about which sort of watcher
- my $meta = $FIELD_METADATA{$field};
- my $type = ( defined $meta->[1] ? $meta->[1] : undef );
-
- if ($type) {
- $self->_SQLLimit(
- ALIAS => $groups,
- FIELD => 'Type',
- VALUE => $type,
- ENTRYAGGREGATOR => 'AND'
- );
- }
-
- $self->Join(
- ALIAS1 => $groups,
- FIELD1 => 'id',
- ALIAS2 => $groupmembers,
- FIELD2 => 'GroupId'
- );
-
- $self->Join(
- ALIAS1 => $groupmembers,
- FIELD1 => 'MemberId',
- ALIAS2 => $users,
- FIELD2 => 'id'
- );
-
- $self->Limit(
- ALIAS => $groupmembers,
- FIELD => 'Disabled',
- VALUE => 0,
- );
-
- $self->Join(
- ALIAS1 => $memberships,
- FIELD1 => 'MemberId',
- ALIAS2 => $users,
- FIELD2 => 'id'
- );
-
- $self->Limit(
- ALIAS => $memberships,
- FIELD => 'Disabled',
- VALUE => 0,
- );
-
-
- $self->_CloseParen;
-
-}
-
-=head2 _CustomFieldDecipher
-
-Try and turn a CF descriptor into (cfid, cfname) object pair.
-
-Takes an optional second parameter of the CF LookupType, defaults to Ticket CFs.
-
-=cut
-
-sub _CustomFieldDecipher {
- my ($self, $string, $lookuptype) = @_;
- $lookuptype ||= $self->_SingularClass->CustomFieldLookupType;
-
- my ($object, $field, $column) = ($string =~ /^(?:(.+?)\.)?\{(.+)\}(?:\.(Content|LargeContent))?$/);
- $field ||= ($string =~ /^{(.*?)}$/)[0] || $string;
-
- my ($cf, $applied_to);
-
- if ( $object ) {
- my $record_class = RT::CustomField->RecordClassFromLookupType($lookuptype);
- $applied_to = $record_class->new( $self->CurrentUser );
- $applied_to->Load( $object );
-
- if ( $applied_to->id ) {
- RT->Logger->debug("Limiting to CFs identified by '$field' applied to $record_class #@{[$applied_to->id]} (loaded via '$object')");
- }
- else {
- RT->Logger->warning("$record_class '$object' doesn't exist, parsed from '$string'");
- $object = 0;
- undef $applied_to;
- }
- }
-
- if ( $field =~ /\D/ ) {
- $object ||= '';
- my $cfs = RT::CustomFields->new( $self->CurrentUser );
- $cfs->Limit( FIELD => 'Name', VALUE => $field, ($applied_to ? (CASESENSITIVE => 0) : ()) );
- $cfs->LimitToLookupType($lookuptype);
-
- if ($applied_to) {
- $cfs->SetContextObject($applied_to);
- $cfs->LimitToObjectId($applied_to->id);
- }
-
- # if there is more then one field the current user can
- # see with the same name then we shouldn't return cf object
- # as we don't know which one to use
- $cf = $cfs->First;
- if ( $cf ) {
- $cf = undef if $cfs->Next;
- }
- }
- else {
- $cf = RT::CustomField->new( $self->CurrentUser );
- $cf->Load( $field );
- $cf->SetContextObject($applied_to)
- if $cf->id and $applied_to;
- }
-
- return ($object, $field, $cf, $column);
-}
-
-=head2 _CustomFieldJoin
-
-Factor out the Join of custom fields so we can use it for sorting too
-
-=cut
-
-our %JOIN_ALIAS_FOR_LOOKUP_TYPE = (
- RT::Ticket->CustomFieldLookupType => sub { "main" },
-);
-
-sub _CustomFieldJoin {
- my ($self, $cfkey, $cfid, $field, $type) = @_;
- $type ||= RT::Ticket->CustomFieldLookupType;
-
- # Perform one Join per CustomField
- if ( $self->{_sql_object_cfv_alias}{$cfkey} ||
- $self->{_sql_cf_alias}{$cfkey} )
- {
- return ( $self->{_sql_object_cfv_alias}{$cfkey},
- $self->{_sql_cf_alias}{$cfkey} );
- }
-
- my $ObjectAlias = $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type}
- ? $JOIN_ALIAS_FOR_LOOKUP_TYPE{$type}->($self)
- : die "We don't know how to join on $type";
-
- my ($ObjectCFs, $CFs);
- if ( $cfid ) {
- $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $ObjectAlias,
- FIELD1 => 'id',
- TABLE2 => 'ObjectCustomFieldValues',
- FIELD2 => 'ObjectId',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $ObjectCFs,
- FIELD => 'CustomField',
- VALUE => $cfid,
- ENTRYAGGREGATOR => 'AND'
- );
- }
- else {
- my $ocfalias = $self->Join(
- TYPE => 'LEFT',
- FIELD1 => 'Queue',
- TABLE2 => 'ObjectCustomFields',
- FIELD2 => 'ObjectId',
- );
-
- $self->SUPER::Limit(
- LEFTJOIN => $ocfalias,
- ENTRYAGGREGATOR => 'OR',
- FIELD => 'ObjectId',
- VALUE => '0',
- );
-
- $CFs = $self->{_sql_cf_alias}{$cfkey} = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $ocfalias,
- FIELD1 => 'CustomField',
- TABLE2 => 'CustomFields',
- FIELD2 => 'id',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $CFs,
- ENTRYAGGREGATOR => 'AND',
- FIELD => 'LookupType',
- VALUE => $type,
- );
- $self->SUPER::Limit(
- LEFTJOIN => $CFs,
- ENTRYAGGREGATOR => 'AND',
- FIELD => 'Name',
- VALUE => $field,
- );
-
- $ObjectCFs = $self->{_sql_object_cfv_alias}{$cfkey} = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $CFs,
- FIELD1 => 'id',
- TABLE2 => 'ObjectCustomFieldValues',
- FIELD2 => 'CustomField',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $ObjectCFs,
- FIELD => 'ObjectId',
- VALUE => "$ObjectAlias.id",
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => 'AND',
- );
- }
-
- $self->SUPER::Limit(
- LEFTJOIN => $ObjectCFs,
- FIELD => 'ObjectType',
- VALUE => RT::CustomField->ObjectTypeFromLookupType($type),
- ENTRYAGGREGATOR => 'AND'
- );
- $self->SUPER::Limit(
- LEFTJOIN => $ObjectCFs,
- FIELD => 'Disabled',
- OPERATOR => '=',
- VALUE => '0',
- ENTRYAGGREGATOR => 'AND'
- );
-
- return ($ObjectCFs, $CFs);
-}
-
-=head2 _CustomFieldLimit
-
-Limit based on CustomFields
-
-Meta Data:
- none
-
-=cut
-
-use Regexp::Common qw(RE_net_IPv4);
-use Regexp::Common::net::CIDR;
-
-
-sub _CustomFieldLimit {
- my ( $self, $_field, $op, $value, %rest ) = @_;
-
- my $meta = $FIELD_METADATA{ $_field };
- my $class = $meta->[1] || 'Ticket';
- my $type = "RT::$class"->CustomFieldLookupType;
-
- my $field = $rest{'SUBKEY'} || die "No field specified";
-
- # For our sanity, we can only limit on one queue at a time
-
- my ($object, $cfid, $cf, $column);
- ($object, $field, $cf, $column) = $self->_CustomFieldDecipher( $field, $type );
- $cfid = $cf ? $cf->id : 0 ;
-
-# If we're trying to find custom fields that don't match something, we
-# want tickets where the custom field has no value at all. Note that
-# we explicitly don't include the "IS NULL" case, since we would
-# otherwise end up with a redundant clause.
-
- my ($negative_op, $null_op, $inv_op, $range_op)
- = $self->ClassifySQLOperation( $op );
-
- my $fix_op = sub {
- return @_ unless RT->Config->Get('DatabaseType') eq 'Oracle';
-
- my %args = @_;
- return %args unless $args{'FIELD'} eq 'LargeContent';
-
- my $op = $args{'OPERATOR'};
- if ( $op eq '=' ) {
- $args{'OPERATOR'} = 'MATCHES';
- }
- elsif ( $op eq '!=' ) {
- $args{'OPERATOR'} = 'NOT MATCHES';
- }
- elsif ( $op =~ /^[<>]=?$/ ) {
- $args{'FUNCTION'} = "TO_CHAR( $args{'ALIAS'}.LargeContent )";
- }
- return %args;
- };
-
- if ( $cf && $cf->Type eq 'IPAddress' ) {
- my $parsed = RT::ObjectCustomFieldValue->ParseIP($value);
- if ($parsed) {
- $value = $parsed;
- }
- else {
- $RT::Logger->warn("$value is not a valid IPAddress");
- }
- }
-
- if ( $cf && $cf->Type eq 'IPAddressRange' ) {
- my ( $start_ip, $end_ip ) =
- RT::ObjectCustomFieldValue->ParseIPRange($value);
- if ( $start_ip && $end_ip ) {
- if ( $op =~ /^([<>])=?$/ ) {
- my $is_less = $1 eq '<' ? 1 : 0;
- if ( $is_less ) {
- $value = $start_ip;
- }
- else {
- $value = $end_ip;
- }
- }
- else {
- $value = join '-', $start_ip, $end_ip;
- }
- }
- else {
- $RT::Logger->warn("$value is not a valid IPAddressRange");
- }
- }
-
- if ( $cf && $cf->Type =~ /^Date(?:Time)?$/ ) {
- my $date = RT::Date->new( $self->CurrentUser );
- $date->Set( Format => 'unknown', Value => $value );
- if ( $date->Unix ) {
-
- if (
- $cf->Type eq 'Date'
- || $value =~ /^\s*(?:today|tomorrow|yesterday)\s*$/i
- || ( $value !~ /midnight|\d+:\d+:\d+/i
- && $date->Time( Timezone => 'user' ) eq '00:00:00' )
- )
- {
- $value = $date->Date( Timezone => 'user' );
- }
- else {
- $value = $date->DateTime;
- }
- }
- else {
- $RT::Logger->warn("$value is not a valid date string");
- }
- }
-
- my $single_value = !$cf || !$cfid || $cf->SingleValue;
-
- my $cfkey = $cfid ? $cfid : "$type-$object.$field";
-
- if ( $null_op && !$column ) {
- # IS[ NOT] NULL without column is the same as has[ no] any CF value,
- # we can reuse our default joins for this operation
- # with column specified we have different situation
- my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type );
- $self->_OpenParen;
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'id',
- OPERATOR => $op,
- VALUE => $value,
- %rest
- );
- $self->_SQLLimit(
- ALIAS => $CFs,
- FIELD => 'Name',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => 'AND',
- ) if $CFs;
- $self->_CloseParen;
- }
- elsif ( $op !~ /^[<>]=?$/ && ( $cf && $cf->Type eq 'IPAddressRange')) {
-
- my ($start_ip, $end_ip) = split /-/, $value;
-
- $self->_OpenParen;
- if ( $op !~ /NOT|!=|<>/i ) { # positive equation
- $self->_CustomFieldLimit(
- $_field, '<=', $end_ip, %rest,
- SUBKEY => $rest{'SUBKEY'}. '.Content',
- );
- $self->_CustomFieldLimit(
- $_field, '>=', $start_ip, %rest,
- SUBKEY => $rest{'SUBKEY'}. '.LargeContent',
- ENTRYAGGREGATOR => 'AND',
- );
- # as well limit borders so DB optimizers can use better
- # estimations and scan less rows
-# have to disable this tweak because of ipv6
-# $self->_CustomFieldLimit(
-# $_field, '>=', '000.000.000.000', %rest,
-# SUBKEY => $rest{'SUBKEY'}. '.Content',
-# ENTRYAGGREGATOR => 'AND',
-# );
-# $self->_CustomFieldLimit(
-# $_field, '<=', '255.255.255.255', %rest,
-# SUBKEY => $rest{'SUBKEY'}. '.LargeContent',
-# ENTRYAGGREGATOR => 'AND',
-# );
- }
- else { # negative equation
- $self->_CustomFieldLimit($_field, '>', $end_ip, %rest);
- $self->_CustomFieldLimit(
- $_field, '<', $start_ip, %rest,
- SUBKEY => $rest{'SUBKEY'}. '.LargeContent',
- ENTRYAGGREGATOR => 'OR',
- );
- # TODO: as well limit borders so DB optimizers can use better
- # estimations and scan less rows, but it's harder to do
- # as we have OR aggregator
- }
- $self->_CloseParen;
- }
- elsif ( !$negative_op || $single_value ) {
- $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++ if !$single_value && !$range_op;
- my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type );
-
- $self->_OpenParen;
-
- $self->_OpenParen;
-
- $self->_OpenParen;
- # if column is defined then deal only with it
- # otherwise search in Content and in LargeContent
- if ( $column ) {
- $self->_SQLLimit( $fix_op->(
- ALIAS => $ObjectCFs,
- FIELD => $column,
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- %rest
- ) );
- $self->_CloseParen;
- $self->_CloseParen;
- $self->_CloseParen;
- }
- else {
- # need special treatment for Date
- if ( $cf and $cf->Type eq 'DateTime' and $op eq '=' && $value !~ /:/ ) {
- # no time specified, that means we want everything on a
- # particular day. in the database, we need to check for >
- # and < the edges of that day.
- my $date = RT::Date->new( $self->CurrentUser );
- $date->Set( Format => 'unknown', Value => $value );
- my $daystart = $date->ISO;
- $date->AddDay;
- my $dayend = $date->ISO;
-
- $self->_OpenParen;
-
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => ">=",
- VALUE => $daystart,
- %rest,
- );
-
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => "<",
- VALUE => $dayend,
- %rest,
- ENTRYAGGREGATOR => 'AND',
- );
-
- $self->_CloseParen;
- }
- elsif ( $op eq '=' || $op eq '!=' || $op eq '<>' ) {
- if ( length( Encode::encode_utf8($value) ) < 256 ) {
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- %rest
- );
- }
- else {
- $self->_OpenParen;
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => '=',
- VALUE => '',
- ENTRYAGGREGATOR => 'OR'
- );
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- ENTRYAGGREGATOR => 'OR'
- );
- $self->_CloseParen;
- $self->_SQLLimit( $fix_op->(
- ALIAS => $ObjectCFs,
- FIELD => 'LargeContent',
- OPERATOR => $op,
- VALUE => $value,
- ENTRYAGGREGATOR => 'AND',
- CASESENSITIVE => 0,
- ) );
- }
- }
- else {
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- %rest
- );
-
- $self->_OpenParen;
- $self->_OpenParen;
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => '=',
- VALUE => '',
- ENTRYAGGREGATOR => 'OR'
- );
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- ENTRYAGGREGATOR => 'OR'
- );
- $self->_CloseParen;
- $self->_SQLLimit( $fix_op->(
- ALIAS => $ObjectCFs,
- FIELD => 'LargeContent',
- OPERATOR => $op,
- VALUE => $value,
- ENTRYAGGREGATOR => 'AND',
- CASESENSITIVE => 0,
- ) );
- $self->_CloseParen;
- }
- $self->_CloseParen;
-
- # XXX: if we join via CustomFields table then
- # because of order of left joins we get NULLs in
- # CF table and then get nulls for those records
- # in OCFVs table what result in wrong results
- # as decifer method now tries to load a CF then
- # we fall into this situation only when there
- # are more than one CF with the name in the DB.
- # the same thing applies to order by call.
- # TODO: reorder joins T <- OCFVs <- CFs <- OCFs if
- # we want treat IS NULL as (not applies or has
- # no value)
- $self->_SQLLimit(
- ALIAS => $CFs,
- FIELD => 'Name',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => 'AND',
- ) if $CFs;
- $self->_CloseParen;
-
- if ($negative_op) {
- $self->_SQLLimit(
- ALIAS => $ObjectCFs,
- FIELD => $column || 'Content',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => 'OR',
- );
- }
-
- $self->_CloseParen;
- }
- }
- else {
- $cfkey .= '.'. $self->{'_sql_multiple_cfs_index'}++;
- my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, $cfid, $field, $type );
-
- # reverse operation
- $op =~ s/!|NOT\s+//i;
-
- # if column is defined then deal only with it
- # otherwise search in Content and in LargeContent
- if ( $column ) {
- $self->SUPER::Limit( $fix_op->(
- LEFTJOIN => $ObjectCFs,
- ALIAS => $ObjectCFs,
- FIELD => $column,
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- ) );
- }
- else {
- $self->SUPER::Limit(
- LEFTJOIN => $ObjectCFs,
- ALIAS => $ObjectCFs,
- FIELD => 'Content',
- OPERATOR => $op,
- VALUE => $value,
- CASESENSITIVE => 0,
- );
- }
- $self->_SQLLimit(
- %rest,
- ALIAS => $ObjectCFs,
- FIELD => 'id',
- OPERATOR => 'IS',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- );
- }
-}
-
-sub _HasAttributeLimit {
- my ( $self, $field, $op, $value, %rest ) = @_;
-
- my $alias = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Attributes',
- FIELD2 => 'ObjectId',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $alias,
- FIELD => 'ObjectType',
- VALUE => 'RT::Ticket',
- ENTRYAGGREGATOR => 'AND'
- );
- $self->SUPER::Limit(
- LEFTJOIN => $alias,
- FIELD => 'Name',
- OPERATOR => $op,
- VALUE => $value,
- ENTRYAGGREGATOR => 'AND'
- );
- $self->_SQLLimit(
- %rest,
- ALIAS => $alias,
- FIELD => 'id',
- OPERATOR => $FIELD_METADATA{$field}->[1]? 'IS NOT': 'IS',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- );
-}
-
-# End Helper Functions
-
-# End of SQL Stuff -------------------------------------------------
-
-
-=head2 OrderByCols ARRAY
-
-A modified version of the OrderBy method which automatically joins where
-C<ALIAS> is set to the name of a watcher type.
-
-=cut
-
-sub OrderByCols {
- my $self = shift;
- my @args = @_;
- my $clause;
- my @res = ();
- my $order = 0;
-
- foreach my $row (@args) {
- if ( $row->{ALIAS} ) {
- push @res, $row;
- next;
- }
- if ( $row->{FIELD} !~ /\./ ) {
- my $meta = $self->FIELDS->{ $row->{FIELD} };
- unless ( $meta ) {
- push @res, $row;
- next;
- }
-
- if ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'Queue' ) {
- my $alias = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => $row->{'FIELD'},
- TABLE2 => 'Queues',
- FIELD2 => 'id',
- );
- push @res, { %$row, ALIAS => $alias, FIELD => "Name" };
- } elsif ( ( $meta->[0] eq 'ENUM' && ($meta->[1]||'') eq 'User' )
- || ( $meta->[0] eq 'WATCHERFIELD' && ($meta->[1]||'') eq 'Owner' )
- ) {
- my $alias = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => $row->{'FIELD'},
- TABLE2 => 'Users',
- FIELD2 => 'id',
- );
- push @res, { %$row, ALIAS => $alias, FIELD => "Name" };
- } else {
- push @res, $row;
- }
- next;
- }
-
- my ( $field, $subkey ) = split /\./, $row->{FIELD}, 2;
- my $meta = $self->FIELDS->{$field};
- if ( defined $meta->[0] && $meta->[0] eq 'WATCHERFIELD' ) {
- # cache alias as we want to use one alias per watcher type for sorting
- my $users = $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] };
- unless ( $users ) {
- $self->{_sql_u_watchers_alias_for_sort}{ $meta->[1] }
- = $users = ( $self->_WatcherJoin( $meta->[1] ) )[2];
- }
- push @res, { %$row, ALIAS => $users, FIELD => $subkey };
- } elsif ( defined $meta->[0] && $meta->[0] eq 'CUSTOMFIELD' ) {
- my ($object, $field, $cf_obj, $column) = $self->_CustomFieldDecipher( $subkey );
- my $cfkey = $cf_obj ? $cf_obj->id : "$object.$field";
- $cfkey .= ".ordering" if !$cf_obj || ($cf_obj->MaxValues||0) != 1;
- my ($ObjectCFs, $CFs) = $self->_CustomFieldJoin( $cfkey, ($cf_obj ?$cf_obj->id :0) , $field );
- # this is described in _CustomFieldLimit
- $self->_SQLLimit(
- ALIAS => $CFs,
- FIELD => 'Name',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 1,
- ENTRYAGGREGATOR => 'AND',
- ) if $CFs;
- unless ($cf_obj) {
- # For those cases where we are doing a join against the
- # CF name, and don't have a CFid, use Unique to make sure
- # we don't show duplicate tickets. NOTE: I'm pretty sure
- # this will stay mixed in for the life of the
- # class/package, and not just for the life of the object.
- # Potential performance issue.
- require DBIx::SearchBuilder::Unique;
- DBIx::SearchBuilder::Unique->import;
- }
- my $CFvs = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $ObjectCFs,
- FIELD1 => 'CustomField',
- TABLE2 => 'CustomFieldValues',
- FIELD2 => 'CustomField',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $CFvs,
- FIELD => 'Name',
- QUOTEVALUE => 0,
- VALUE => $ObjectCFs . ".Content",
- ENTRYAGGREGATOR => 'AND'
- );
-
- push @res, { %$row, ALIAS => $CFvs, FIELD => 'SortOrder' };
- push @res, { %$row, ALIAS => $ObjectCFs, FIELD => 'Content' };
- } elsif ( $field eq "Custom" && $subkey eq "Ownership") {
- # PAW logic is "reversed"
- my $order = "ASC";
- if (exists $row->{ORDER} ) {
- my $o = $row->{ORDER};
- delete $row->{ORDER};
- $order = "DESC" if $o =~ /asc/i;
- }
-
- # Ticket.Owner 1 0 X
- # Unowned Tickets 0 1 X
- # Else 0 0 X
-
- foreach my $uid ( $self->CurrentUser->Id, RT->Nobody->Id ) {
- if ( RT->Config->Get('DatabaseType') eq 'Oracle' ) {
- my $f = ($row->{'ALIAS'} || 'main') .'.Owner';
- push @res, {
- %$row,
- FIELD => undef,
- ALIAS => '',
- FUNCTION => "CASE WHEN $f=$uid THEN 1 ELSE 0 END",
- ORDER => $order
- };
- } else {
- push @res, {
- %$row,
- FIELD => undef,
- FUNCTION => "Owner=$uid",
- ORDER => $order
- };
- }
- }
-
- push @res, { %$row, FIELD => "Priority", ORDER => $order } ;
-
- } elsif ( $field eq 'Customer' ) { #Freeside
- # OrderBy(FIELD => expression) doesn't work, it has to be
- # an actual field, so we have to do the join even if sorting
- # by custnum
- my $custalias = $self->JoinToCustomer;
- my $cust_field = lc($subkey);
- if ( !$cust_field or $cust_field eq 'number' ) {
- $cust_field = 'custnum';
- }
- elsif ( $cust_field eq 'name' ) {
- $cust_field = "COALESCE( $custalias.company,
- $custalias.last || ', ' || $custalias.first
- )";
- }
- else { # order by cust_main fields directly: 'Customer.agentnum'
- $cust_field = $subkey;
- }
- push @res, { %$row, ALIAS => $custalias, FIELD => $cust_field };
-
- } elsif ( $field eq 'Service' ) {
-
- my $svcalias = $self->JoinToService;
- my $svc_field = lc($subkey);
- if ( !$svc_field or $svc_field eq 'number' ) {
- $svc_field = 'svcnum';
- }
- push @res, { %$row, ALIAS => $svcalias, FIELD => $svc_field };
-
- } #Freeside
-
- else {
- push @res, $row;
- }
- }
- return $self->SUPER::OrderByCols(@res);
-}
-
-#Freeside
-
-sub JoinToCustLinks {
- # Set up join to links (id = localbase),
- # limit link type to 'MemberOf',
- # and target value to any Freeside custnum URI.
- # Return the linkalias for further join/limit action,
- # and an sql expression to retrieve the custnum.
- my $self = shift;
- # only join once for each RT::Tickets object
- my $linkalias = $self->{cust_main_linkalias};
- if (!$linkalias) {
- $linkalias = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Links',
- FIELD2 => 'LocalBase',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Base',
- OPERATOR => 'LIKE',
- VALUE => 'fsck.com-rt://%/ticket/%',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Type',
- OPERATOR => '=',
- VALUE => 'MemberOf',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Target',
- OPERATOR => 'STARTSWITH',
- VALUE => 'freeside://freeside/cust_main/',
- );
- $self->{cust_main_linkalias} = $linkalias;
- }
- my $custnum_sql = "CAST(SUBSTR($linkalias.Target,31) AS ";
- if ( RT->Config->Get('DatabaseType') eq 'mysql' ) {
- $custnum_sql .= 'SIGNED INTEGER)';
- }
- else {
- $custnum_sql .= 'INTEGER)';
- }
- return ($linkalias, $custnum_sql);
-}
-
-sub JoinToCustomer {
- my $self = shift;
- my ($linkalias, $custnum_sql) = $self->JoinToCustLinks;
- # don't reuse this join, though--negative queries need
- # independent joins
- my $custalias = $self->Join(
- TYPE => 'LEFT',
- EXPRESSION => $custnum_sql,
- TABLE2 => 'cust_main',
- FIELD2 => 'custnum',
- );
- return $custalias;
-}
-
-sub JoinToSvcLinks {
- my $self = shift;
- my $linkalias = $self->{cust_svc_linkalias};
- if (!$linkalias) {
- $linkalias = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Links',
- FIELD2 => 'LocalBase',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Base',
- OPERATOR => 'LIKE',
- VALUE => 'fsck.com-rt://%/ticket/%',
- );
-
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Type',
- OPERATOR => '=',
- VALUE => 'MemberOf',
- );
- $self->SUPER::Limit(
- LEFTJOIN => $linkalias,
- FIELD => 'Target',
- OPERATOR => 'STARTSWITH',
- VALUE => 'freeside://freeside/cust_svc/',
- );
- $self->{cust_svc_linkalias} = $linkalias;
- }
- my $svcnum_sql = "CAST(SUBSTR($linkalias.Target,30) AS ";
- if ( RT->Config->Get('DatabaseType') eq 'mysql' ) {
- $svcnum_sql .= 'SIGNED INTEGER)';
- }
- else {
- $svcnum_sql .= 'INTEGER)';
- }
- return ($linkalias, $svcnum_sql);
-}
-
-sub JoinToService {
- my $self = shift;
- my ($linkalias, $svcnum_sql) = $self->JoinToSvcLinks;
- $self->Join(
- TYPE => 'LEFT',
- EXPRESSION => $svcnum_sql,
- TABLE2 => 'cust_svc',
- FIELD2 => 'svcnum',
- );
-}
-
-# This creates an alternate left join path to cust_main via cust_svc.
-# _FreesideFieldLimit needs to add this as a separate, independent join
-# and include all tickets that have a matching cust_main record via
-# either path.
-sub JoinToCustomerViaService {
- my $self = shift;
- my $svcalias = $self->JoinToService;
- my $cust_pkg = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $svcalias,
- FIELD1 => 'pkgnum',
- TABLE2 => 'cust_pkg',
- FIELD2 => 'pkgnum',
- );
- my $cust_main = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $cust_pkg,
- FIELD1 => 'custnum',
- TABLE2 => 'cust_main',
- FIELD2 => 'custnum',
- );
- $cust_main;
-}
-
-sub _FreesideFieldLimit {
- my ( $self, $field, $op, $value, %rest ) = @_;
- my $is_negative = 0;
- if ( $op eq '!=' || $op =~ /\bNOT\b/i ) {
- # if the op is negative, do the join as though
- # the op were positive, then accept only records
- # where the right-side join key is null.
- $is_negative = 1;
- $op = '=' if $op eq '!=';
- $op =~ s/\bNOT\b//;
- }
-
- my (@alias, $table2, $subfield, $pkey);
- if ( $field eq 'Customer' ) {
- push @alias, $self->JoinToCustomer;
- push @alias, $self->JoinToCustomerViaService;
- $pkey = 'custnum';
- }
- elsif ( $field eq 'Service' ) {
- push @alias, $self->JoinToService;
- $pkey = 'svcnum';
- }
- else {
- die "malformed Freeside query: $field";
- }
-
- $subfield = $rest{SUBKEY} || $pkey;
- # compound subkey: separate into table name and field in that table
- # (must be linked by custnum)
- $subfield = lc($subfield);
- ($table2, $subfield) = ($1, $2) if $subfield =~ /^(\w+)?\.(\w+)$/;
- $subfield = $pkey if $subfield eq 'number';
-
- # if it's compound, create a join from cust_main or cust_svc to that
- # table, using custnum or svcnum, and Limit on that table instead.
- my @_SQLLimit = ();
- foreach my $a (@alias) {
- if ( $table2 ) {
- $a = $self->Join(
- TYPE => 'LEFT',
- ALIAS1 => $a,
- FIELD1 => $pkey,
- TABLE2 => $table2,
- FIELD2 => $pkey,
- );
- }
-
- # do the actual Limit
- $self->SUPER::Limit(
- LEFTJOIN => $a,
- FIELD => $subfield,
- OPERATOR => $op,
- VALUE => $value,
- ENTRYAGGREGATOR => 'AND',
- # no SUBCLAUSE needed, limits on different aliases across left joins
- # are inherently independent
- );
-
- # then, since it's a left join, exclude tickets for which there is now
- # no matching record in the table we just limited on. (Or where there
- # is a matching record, if $is_negative.)
- # For a cust_main query (where there are two different aliases), this
- # will produce a subclause: "cust_main_1.custnum IS NOT NULL OR
- # cust_main_2.custnum IS NOT NULL" (or "IS NULL AND..." for a negative
- # query).
- #$self->_SQLLimit(
- push @_SQLLimit, {
- %rest,
- ALIAS => $a,
- FIELD => $pkey,
- OPERATOR => $is_negative ? 'IS' : 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => $is_negative ? 'AND' : 'OR',
- SUBCLAUSE => 'fs_limit',
- };
- }
-
- $self->_OpenParen;
- foreach my $_SQLLimit (@_SQLLimit) {
- $self->_SQLLimit( %$_SQLLimit);
- }
- $self->_CloseParen;
-
-}
-
-#Freeside
-
-=head2 Limit
-
-Takes a paramhash with the fields FIELD, OPERATOR, VALUE and DESCRIPTION
-Generally best called from LimitFoo methods
-
-=cut
-
-sub Limit {
- my $self = shift;
- my %args = (
- FIELD => undef,
- OPERATOR => '=',
- VALUE => undef,
- DESCRIPTION => undef,
- @_
- );
- $args{'DESCRIPTION'} = $self->loc(
- "[_1] [_2] [_3]", $args{'FIELD'},
- $args{'OPERATOR'}, $args{'VALUE'}
- )
- if ( !defined $args{'DESCRIPTION'} );
-
- my $index = $self->_NextIndex;
-
-# make the TicketRestrictions hash the equivalent of whatever we just passed in;
-
- %{ $self->{'TicketRestrictions'}{$index} } = %args;
-
- $self->{'RecalcTicketLimits'} = 1;
-
-# If we're looking at the effective id, we don't want to append the other clause
-# which limits us to tickets where id = effective id
- if ( $args{'FIELD'} eq 'EffectiveId'
- && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) )
- {
- $self->{'looking_at_effective_id'} = 1;
- }
-
- if ( $args{'FIELD'} eq 'Type'
- && ( !$args{'ALIAS'} || $args{'ALIAS'} eq 'main' ) )
- {
- $self->{'looking_at_type'} = 1;
- }
-
- return ($index);
-}
-
-
-
-
-=head2 LimitQueue
-
-LimitQueue takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of = or !=. (It defaults to =).
-VALUE is a queue id or Name.
-
-
-=cut
-
-sub LimitQueue {
- my $self = shift;
- my %args = (
- VALUE => undef,
- OPERATOR => '=',
- @_
- );
-
- #TODO VALUE should also take queue objects
- if ( defined $args{'VALUE'} && $args{'VALUE'} !~ /^\d+$/ ) {
- my $queue = RT::Queue->new( $self->CurrentUser );
- $queue->Load( $args{'VALUE'} );
- $args{'VALUE'} = $queue->Id;
- }
-
- # What if they pass in an Id? Check for isNum() and convert to
- # string.
-
- #TODO check for a valid queue here
-
- $self->Limit(
- FIELD => 'Queue',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join(
- ' ', $self->loc('Queue'), $args{'OPERATOR'}, $args{'VALUE'},
- ),
- );
-
-}
-
-
-
-=head2 LimitStatus
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of = or !=.
-VALUE is a status.
-
-RT adds Status != 'deleted' until object has
-allow_deleted_search internal property set.
-$tickets->{'allow_deleted_search'} = 1;
-$tickets->LimitStatus( VALUE => 'deleted' );
-
-=cut
-
-sub LimitStatus {
- my $self = shift;
- my %args = (
- OPERATOR => '=',
- @_
- );
- $self->Limit(
- FIELD => 'Status',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Status'), $args{'OPERATOR'},
- $self->loc( $args{'VALUE'} ) ),
- );
-}
-
-
-
-=head2 IgnoreType
-
-If called, this search will not automatically limit the set of results found
-to tickets of type "Ticket". Tickets of other types, such as "project" and
-"approval" will be found.
-
-=cut
-
-sub IgnoreType {
- my $self = shift;
-
- # Instead of faking a Limit that later gets ignored, fake up the
- # fact that we're already looking at type, so that the check in
- # Tickets_SQL/FromSQL goes down the right branch
-
- # $self->LimitType(VALUE => '__any');
- $self->{looking_at_type} = 1;
-}
-
-
-
-=head2 LimitType
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of = or !=, it defaults to "=".
-VALUE is a string to search for in the type of the ticket.
-
-
-
-=cut
-
-sub LimitType {
- my $self = shift;
- my %args = (
- OPERATOR => '=',
- VALUE => undef,
- @_
- );
- $self->Limit(
- FIELD => 'Type',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Type'), $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-
-
-=head2 LimitSubject
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of = or !=.
-VALUE is a string to search for in the subject of the ticket.
-
-=cut
-
-sub LimitSubject {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'Subject',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Subject'), $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-# Things that can be > < = !=
-
-
-=head2 LimitId
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a ticket Id to search for
-
-=cut
-
-sub LimitId {
- my $self = shift;
- my %args = (
- OPERATOR => '=',
- @_
- );
-
- $self->Limit(
- FIELD => 'id',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION =>
- join( ' ', $self->loc('Id'), $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitPriority
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a value to match the ticket's priority against
-
-=cut
-
-sub LimitPriority {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'Priority',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Priority'),
- $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitInitialPriority
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a value to match the ticket's initial priority against
-
-
-=cut
-
-sub LimitInitialPriority {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'InitialPriority',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Initial Priority'), $args{'OPERATOR'},
- $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitFinalPriority
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a value to match the ticket's final priority against
-
-=cut
-
-sub LimitFinalPriority {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'FinalPriority',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Final Priority'), $args{'OPERATOR'},
- $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitTimeWorked
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a value to match the ticket's TimeWorked attribute
-
-=cut
-
-sub LimitTimeWorked {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'TimeWorked',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Time Worked'),
- $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitTimeLeft
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, >, < or !=.
-VALUE is a value to match the ticket's TimeLeft attribute
-
-=cut
-
-sub LimitTimeLeft {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'TimeLeft',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Time Left'),
- $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-
-
-=head2 LimitContent
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, LIKE, NOT LIKE or !=.
-VALUE is a string to search for in the body of the ticket
-
-=cut
-
-sub LimitContent {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'Content',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Ticket content'), $args{'OPERATOR'},
- $args{'VALUE'}, ),
- );
-}
-
-
-
-=head2 LimitFilename
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, LIKE, NOT LIKE or !=.
-VALUE is a string to search for in the body of the ticket
-
-=cut
-
-sub LimitFilename {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'Filename',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Attachment filename'), $args{'OPERATOR'},
- $args{'VALUE'}, ),
- );
-}
-
-
-=head2 LimitContentType
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of =, LIKE, NOT LIKE or !=.
-VALUE is a content type to search ticket attachments for
-
-=cut
-
-sub LimitContentType {
- my $self = shift;
- my %args = (@_);
- $self->Limit(
- FIELD => 'ContentType',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Ticket content type'), $args{'OPERATOR'},
- $args{'VALUE'}, ),
- );
-}
-
-
-
-
-
-=head2 LimitOwner
-
-Takes a paramhash with the fields OPERATOR and VALUE.
-OPERATOR is one of = or !=.
-VALUE is a user id.
-
-=cut
-
-sub LimitOwner {
- my $self = shift;
- my %args = (
- OPERATOR => '=',
- @_
- );
-
- my $owner = RT::User->new( $self->CurrentUser );
- $owner->Load( $args{'VALUE'} );
-
- # FIXME: check for a valid $owner
- $self->Limit(
- FIELD => 'Owner',
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- DESCRIPTION => join( ' ',
- $self->loc('Owner'), $args{'OPERATOR'}, $owner->Name(), ),
- );
-
-}
-
-
-
-
-=head2 LimitWatcher
-
- Takes a paramhash with the fields OPERATOR, TYPE and VALUE.
- OPERATOR is one of =, LIKE, NOT LIKE or !=.
- VALUE is a value to match the ticket's watcher email addresses against
- TYPE is the sort of watchers you want to match against. Leave it undef if you want to search all of them
-
-
-=cut
-
-sub LimitWatcher {
- my $self = shift;
- my %args = (
- OPERATOR => '=',
- VALUE => undef,
- TYPE => undef,
- @_
- );
-
- #build us up a description
- my ( $watcher_type, $desc );
- if ( $args{'TYPE'} ) {
- $watcher_type = $args{'TYPE'};
- }
- else {
- $watcher_type = "Watcher";
- }
-
- $self->Limit(
- FIELD => $watcher_type,
- VALUE => $args{'VALUE'},
- OPERATOR => $args{'OPERATOR'},
- TYPE => $args{'TYPE'},
- DESCRIPTION => join( ' ',
- $self->loc($watcher_type),
- $args{'OPERATOR'}, $args{'VALUE'}, ),
- );
-}
-
-
-
-
-
-
-=head2 LimitLinkedTo
-
-LimitLinkedTo takes a paramhash with two fields: TYPE and TARGET
-TYPE limits the sort of link we want to search on
-
-TYPE = { RefersTo, MemberOf, DependsOn }
-
-TARGET is the id or URI of the TARGET of the link
-
-=cut
-
-sub LimitLinkedTo {
- my $self = shift;
- my %args = (
- TARGET => undef,
- TYPE => undef,
- OPERATOR => '=',
- @_
- );
-
- $self->Limit(
- FIELD => 'LinkedTo',
- BASE => undef,
- TARGET => $args{'TARGET'},
- TYPE => $args{'TYPE'},
- DESCRIPTION => $self->loc(
- "Tickets [_1] by [_2]",
- $self->loc( $args{'TYPE'} ),
- $args{'TARGET'}
- ),
- OPERATOR => $args{'OPERATOR'},
- );
-}
-
-
-
-=head2 LimitLinkedFrom
-
-LimitLinkedFrom takes a paramhash with two fields: TYPE and BASE
-TYPE limits the sort of link we want to search on
-
-
-BASE is the id or URI of the BASE of the link
-
-=cut
-
-sub LimitLinkedFrom {
- my $self = shift;
- my %args = (
- BASE => undef,
- TYPE => undef,
- OPERATOR => '=',
- @_
- );
-
- # translate RT2 From/To naming to RT3 TicketSQL naming
- my %fromToMap = qw(DependsOn DependentOn
- MemberOf HasMember
- RefersTo ReferredToBy);
-
- my $type = $args{'TYPE'};
- $type = $fromToMap{$type} if exists( $fromToMap{$type} );
-
- $self->Limit(
- FIELD => 'LinkedTo',
- TARGET => undef,
- BASE => $args{'BASE'},
- TYPE => $type,
- DESCRIPTION => $self->loc(
- "Tickets [_1] [_2]",
- $self->loc( $args{'TYPE'} ),
- $args{'BASE'},
- ),
- OPERATOR => $args{'OPERATOR'},
- );
-}
-
-
-sub LimitMemberOf {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedTo(
- @_,
- TARGET => $ticket_id,
- TYPE => 'MemberOf',
- );
-}
-
-
-sub LimitHasMember {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedFrom(
- @_,
- BASE => "$ticket_id",
- TYPE => 'HasMember',
- );
-
-}
-
-
-
-sub LimitDependsOn {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedTo(
- @_,
- TARGET => $ticket_id,
- TYPE => 'DependsOn',
- );
-
-}
-
-
-
-sub LimitDependedOnBy {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedFrom(
- @_,
- BASE => $ticket_id,
- TYPE => 'DependentOn',
- );
-
-}
-
-
-
-sub LimitRefersTo {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedTo(
- @_,
- TARGET => $ticket_id,
- TYPE => 'RefersTo',
- );
-
-}
-
-
-
-sub LimitReferredToBy {
- my $self = shift;
- my $ticket_id = shift;
- return $self->LimitLinkedFrom(
- @_,
- BASE => $ticket_id,
- TYPE => 'ReferredToBy',
- );
-}
-
-
-
-
-
-=head2 LimitDate (FIELD => 'DateField', OPERATOR => $oper, VALUE => $ISODate)
-
-Takes a paramhash with the fields FIELD OPERATOR and VALUE.
-
-OPERATOR is one of > or <
-VALUE is a date and time in ISO format in GMT
-FIELD is one of Starts, Started, Told, Created, Resolved, LastUpdated
-
-There are also helper functions of the form LimitFIELD that eliminate
-the need to pass in a FIELD argument.
-
-=cut
-
-sub LimitDate {
- my $self = shift;
- my %args = (
- FIELD => undef,
- VALUE => undef,
- OPERATOR => undef,
-
- @_
- );
-
- #Set the description if we didn't get handed it above
- unless ( $args{'DESCRIPTION'} ) {
- $args{'DESCRIPTION'} = $args{'FIELD'} . " "
- . $args{'OPERATOR'} . " "
- . $args{'VALUE'} . " GMT";
- }
-
- $self->Limit(%args);
-
-}
-
-
-sub LimitCreated {
- my $self = shift;
- $self->LimitDate( FIELD => 'Created', @_ );
-}
-
-sub LimitDue {
- my $self = shift;
- $self->LimitDate( FIELD => 'Due', @_ );
-
-}
-
-sub LimitStarts {
- my $self = shift;
- $self->LimitDate( FIELD => 'Starts', @_ );
-
-}
-
-sub LimitStarted {
- my $self = shift;
- $self->LimitDate( FIELD => 'Started', @_ );
-}
-
-sub LimitResolved {
- my $self = shift;
- $self->LimitDate( FIELD => 'Resolved', @_ );
-}
-
-sub LimitTold {
- my $self = shift;
- $self->LimitDate( FIELD => 'Told', @_ );
-}
-
-sub LimitLastUpdated {
- my $self = shift;
- $self->LimitDate( FIELD => 'LastUpdated', @_ );
-}
-
-#
-
-=head2 LimitTransactionDate (OPERATOR => $oper, VALUE => $ISODate)
-
-Takes a paramhash with the fields FIELD OPERATOR and VALUE.
-
-OPERATOR is one of > or <
-VALUE is a date and time in ISO format in GMT
-
-
-=cut
-
-sub LimitTransactionDate {
- my $self = shift;
- my %args = (
- FIELD => 'TransactionDate',
- VALUE => undef,
- OPERATOR => undef,
-
- @_
- );
-
- # <20021217042756.GK28744@pallas.fsck.com>
- # "Kill It" - Jesse.
-
- #Set the description if we didn't get handed it above
- unless ( $args{'DESCRIPTION'} ) {
- $args{'DESCRIPTION'} = $args{'FIELD'} . " "
- . $args{'OPERATOR'} . " "
- . $args{'VALUE'} . " GMT";
- }
-
- $self->Limit(%args);
-
-}
-
-
-
-
-=head2 LimitCustomField
-
-Takes a paramhash of key/value pairs with the following keys:
-
-=over 4
-
-=item CUSTOMFIELD - CustomField name or id. If a name is passed, an additional parameter QUEUE may also be passed to distinguish the custom field.
-
-=item OPERATOR - The usual Limit operators
-
-=item VALUE - The value to compare against
-
-=back
-
-=cut
-
-sub LimitCustomField {
- my $self = shift;
- my %args = (
- VALUE => undef,
- CUSTOMFIELD => undef,
- OPERATOR => '=',
- DESCRIPTION => undef,
- FIELD => 'CustomFieldValue',
- QUOTEVALUE => 1,
- @_
- );
-
- my $CF = RT::CustomField->new( $self->CurrentUser );
- if ( $args{CUSTOMFIELD} =~ /^\d+$/ ) {
- $CF->Load( $args{CUSTOMFIELD} );
- }
- else {
- $CF->LoadByNameAndQueue(
- Name => $args{CUSTOMFIELD},
- Queue => $args{QUEUE}
- );
- $args{CUSTOMFIELD} = $CF->Id;
- }
-
- #If we are looking to compare with a null value.
- if ( $args{'OPERATOR'} =~ /^is$/i ) {
- $args{'DESCRIPTION'}
- ||= $self->loc( "Custom field [_1] has no value.", $CF->Name );
- }
- elsif ( $args{'OPERATOR'} =~ /^is not$/i ) {
- $args{'DESCRIPTION'}
- ||= $self->loc( "Custom field [_1] has a value.", $CF->Name );
- }
-
- # if we're not looking to compare with a null value
- else {
- $args{'DESCRIPTION'} ||= $self->loc( "Custom field [_1] [_2] [_3]",
- $CF->Name, $args{OPERATOR}, $args{VALUE} );
- }
-
- if ( defined $args{'QUEUE'} && $args{'QUEUE'} =~ /\D/ ) {
- my $QueueObj = RT::Queue->new( $self->CurrentUser );
- $QueueObj->Load( $args{'QUEUE'} );
- $args{'QUEUE'} = $QueueObj->Id;
- }
- delete $args{'QUEUE'} unless defined $args{'QUEUE'} && length $args{'QUEUE'};
-
- my @rest;
- @rest = ( ENTRYAGGREGATOR => 'AND' )
- if ( $CF->Type eq 'SelectMultiple' );
-
- $self->Limit(
- VALUE => $args{VALUE},
- FIELD => "CF"
- .(defined $args{'QUEUE'}? ".$args{'QUEUE'}" : '' )
- .".{" . $CF->Name . "}",
- OPERATOR => $args{OPERATOR},
- CUSTOMFIELD => 1,
- @rest,
- );
-
- $self->{'RecalcTicketLimits'} = 1;
-}
-
-
-
-=head2 _NextIndex
-
-Keep track of the counter for the array of restrictions
-
-=cut
-
-sub _NextIndex {
- my $self = shift;
- return ( $self->{'restriction_index'}++ );
-}
-
-
-
-
-sub _Init {
- my $self = shift;
- $self->{'table'} = "Tickets";
- $self->{'RecalcTicketLimits'} = 1;
- $self->{'looking_at_effective_id'} = 0;
- $self->{'looking_at_type'} = 0;
- $self->{'restriction_index'} = 1;
- $self->{'primary_key'} = "id";
- delete $self->{'items_array'};
- delete $self->{'item_map'};
- delete $self->{'columns_to_display'};
- $self->SUPER::_Init(@_);
-
- $self->_InitSQL;
-
-}
-
-
-sub Count {
- my $self = shift;
- $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 );
- return ( $self->SUPER::Count() );
-}
-
-
-sub CountAll {
- my $self = shift;
- $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 );
- return ( $self->SUPER::CountAll() );
-}
-
-
-
-=head2 ItemsArrayRef
-
-Returns a reference to the set of all items found in this search
-
-=cut
-
-sub ItemsArrayRef {
- my $self = shift;
-
- return $self->{'items_array'} if $self->{'items_array'};
-
- my $placeholder = $self->_ItemsCounter;
- $self->GotoFirstItem();
- while ( my $item = $self->Next ) {
- push( @{ $self->{'items_array'} }, $item );
- }
- $self->GotoItem($placeholder);
- $self->{'items_array'}
- = $self->ItemsOrderBy( $self->{'items_array'} );
-
- return $self->{'items_array'};
-}
-
-sub ItemsArrayRefWindow {
- my $self = shift;
- my $window = shift;
-
- my @old = ($self->_ItemsCounter, $self->RowsPerPage, $self->FirstRow+1);
-
- $self->RowsPerPage( $window );
- $self->FirstRow(1);
- $self->GotoFirstItem;
-
- my @res;
- while ( my $item = $self->Next ) {
- push @res, $item;
- }
-
- $self->RowsPerPage( $old[1] );
- $self->FirstRow( $old[2] );
- $self->GotoItem( $old[0] );
-
- return \@res;
-}
-
-
-sub Next {
- my $self = shift;
-
- $self->_ProcessRestrictions() if ( $self->{'RecalcTicketLimits'} == 1 );
-
- my $Ticket = $self->SUPER::Next;
- return $Ticket unless $Ticket;
-
- if ( $Ticket->__Value('Status') eq 'deleted'
- && !$self->{'allow_deleted_search'} )
- {
- return $self->Next;
- }
- elsif ( RT->Config->Get('UseSQLForACLChecks') ) {
- # if we found a ticket with this option enabled then
- # all tickets we found are ACLed, cache this fact
- my $key = join ";:;", $self->CurrentUser->id, 'ShowTicket', 'RT::Ticket-'. $Ticket->id;
- $RT::Principal::_ACL_CACHE->set( $key => 1 );
- return $Ticket;
- }
- elsif ( $Ticket->CurrentUserHasRight('ShowTicket') ) {
- # has rights
- return $Ticket;
- }
- else {
- # If the user doesn't have the right to show this ticket
- return $self->Next;
- }
-}
-
-sub _DoSearch {
- my $self = shift;
- $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks');
- return $self->SUPER::_DoSearch( @_ );
-}
-
-sub _DoCount {
- my $self = shift;
- $self->CurrentUserCanSee if RT->Config->Get('UseSQLForACLChecks');
- return $self->SUPER::_DoCount( @_ );
-}
-
-sub _RolesCanSee {
- my $self = shift;
-
- my $cache_key = 'RolesHasRight;:;ShowTicket';
-
- if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) {
- return %$cached;
- }
-
- my $ACL = RT::ACL->new( RT->SystemUser );
- $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' );
- $ACL->Limit( FIELD => 'PrincipalType', OPERATOR => '!=', VALUE => 'Group' );
- my $principal_alias = $ACL->Join(
- ALIAS1 => 'main',
- FIELD1 => 'PrincipalId',
- TABLE2 => 'Principals',
- FIELD2 => 'id',
- );
- $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 );
-
- my %res = ();
- foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) {
- my $role = $ACE->__Value('PrincipalType');
- my $type = $ACE->__Value('ObjectType');
- if ( $type eq 'RT::System' ) {
- $res{ $role } = 1;
- }
- elsif ( $type eq 'RT::Queue' ) {
- next if $res{ $role } && !ref $res{ $role };
- push @{ $res{ $role } ||= [] }, $ACE->__Value('ObjectId');
- }
- else {
- $RT::Logger->error('ShowTicket right is granted on unsupported object');
- }
- }
- $RT::Principal::_ACL_CACHE->set( $cache_key => \%res );
- return %res;
-}
-
-sub _DirectlyCanSeeIn {
- my $self = shift;
- my $id = $self->CurrentUser->id;
-
- my $cache_key = 'User-'. $id .';:;ShowTicket;:;DirectlyCanSeeIn';
- if ( my $cached = $RT::Principal::_ACL_CACHE->fetch( $cache_key ) ) {
- return @$cached;
- }
-
- my $ACL = RT::ACL->new( RT->SystemUser );
- $ACL->Limit( FIELD => 'RightName', VALUE => 'ShowTicket' );
- my $principal_alias = $ACL->Join(
- ALIAS1 => 'main',
- FIELD1 => 'PrincipalId',
- TABLE2 => 'Principals',
- FIELD2 => 'id',
- );
- $ACL->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 );
- my $cgm_alias = $ACL->Join(
- ALIAS1 => 'main',
- FIELD1 => 'PrincipalId',
- TABLE2 => 'CachedGroupMembers',
- FIELD2 => 'GroupId',
- );
- $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id );
- $ACL->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 );
-
- my @res = ();
- foreach my $ACE ( @{ $ACL->ItemsArrayRef } ) {
- my $type = $ACE->__Value('ObjectType');
- if ( $type eq 'RT::System' ) {
- # If user is direct member of a group that has the right
- # on the system then he can see any ticket
- $RT::Principal::_ACL_CACHE->set( $cache_key => [-1] );
- return (-1);
- }
- elsif ( $type eq 'RT::Queue' ) {
- push @res, $ACE->__Value('ObjectId');
- }
- else {
- $RT::Logger->error('ShowTicket right is granted on unsupported object');
- }
- }
- $RT::Principal::_ACL_CACHE->set( $cache_key => \@res );
- return @res;
-}
-
-sub CurrentUserCanSee {
- my $self = shift;
- return if $self->{'_sql_current_user_can_see_applied'};
-
- return $self->{'_sql_current_user_can_see_applied'} = 1
- if $self->CurrentUser->UserObj->HasRight(
- Right => 'SuperUser', Object => $RT::System
- );
-
- my $id = $self->CurrentUser->id;
-
- # directly can see in all queues then we have nothing to do
- my @direct_queues = $self->_DirectlyCanSeeIn;
- return $self->{'_sql_current_user_can_see_applied'} = 1
- if @direct_queues && $direct_queues[0] == -1;
-
- my %roles = $self->_RolesCanSee;
- {
- my %skip = map { $_ => 1 } @direct_queues;
- foreach my $role ( keys %roles ) {
- next unless ref $roles{ $role };
-
- my @queues = grep !$skip{$_}, @{ $roles{ $role } };
- if ( @queues ) {
- $roles{ $role } = \@queues;
- } else {
- delete $roles{ $role };
- }
- }
- }
-
-# there is no global watchers, only queues and tickes, if at
-# some point we will add global roles then it's gonna blow
-# the idea here is that if the right is set globaly for a role
-# and user plays this role for a queue directly not a ticket
-# then we have to check in advance
- if ( my @tmp = grep $_ ne 'Owner' && !ref $roles{ $_ }, keys %roles ) {
-
- my $groups = RT::Groups->new( RT->SystemUser );
- $groups->Limit( FIELD => 'Domain', VALUE => 'RT::Queue-Role' );
- foreach ( @tmp ) {
- $groups->Limit( FIELD => 'Type', VALUE => $_ );
- }
- my $principal_alias = $groups->Join(
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'Principals',
- FIELD2 => 'id',
- );
- $groups->Limit( ALIAS => $principal_alias, FIELD => 'Disabled', VALUE => 0 );
- my $cgm_alias = $groups->Join(
- ALIAS1 => 'main',
- FIELD1 => 'id',
- TABLE2 => 'CachedGroupMembers',
- FIELD2 => 'GroupId',
- );
- $groups->Limit( ALIAS => $cgm_alias, FIELD => 'MemberId', VALUE => $id );
- $groups->Limit( ALIAS => $cgm_alias, FIELD => 'Disabled', VALUE => 0 );
- while ( my $group = $groups->Next ) {
- push @direct_queues, $group->Instance;
- }
- }
-
- unless ( @direct_queues || keys %roles ) {
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- ALIAS => 'main',
- FIELD => 'id',
- VALUE => 0,
- ENTRYAGGREGATOR => 'AND',
- );
- return $self->{'_sql_current_user_can_see_applied'} = 1;
- }
-
- {
- my $join_roles = keys %roles;
- $join_roles = 0 if $join_roles == 1 && $roles{'Owner'};
- my ($role_group_alias, $cgm_alias);
- if ( $join_roles ) {
- $role_group_alias = $self->_RoleGroupsJoin( New => 1 );
- $cgm_alias = $self->_GroupMembersJoin( GroupsAlias => $role_group_alias );
- $self->SUPER::Limit(
- LEFTJOIN => $cgm_alias,
- FIELD => 'MemberId',
- OPERATOR => '=',
- VALUE => $id,
- );
- }
- my $limit_queues = sub {
- my $ea = shift;
- my @queues = @_;
-
- return unless @queues;
- if ( @queues == 1 ) {
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- ALIAS => 'main',
- FIELD => 'Queue',
- VALUE => $_[0],
- ENTRYAGGREGATOR => $ea,
- );
- } else {
- $self->SUPER::_OpenParen('ACL');
- foreach my $q ( @queues ) {
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- ALIAS => 'main',
- FIELD => 'Queue',
- VALUE => $q,
- ENTRYAGGREGATOR => $ea,
- );
- $ea = 'OR';
- }
- $self->SUPER::_CloseParen('ACL');
- }
- return 1;
- };
-
- $self->SUPER::_OpenParen('ACL');
- my $ea = 'AND';
- $ea = 'OR' if $limit_queues->( $ea, @direct_queues );
- while ( my ($role, $queues) = each %roles ) {
- $self->SUPER::_OpenParen('ACL');
- if ( $role eq 'Owner' ) {
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- FIELD => 'Owner',
- VALUE => $id,
- ENTRYAGGREGATOR => $ea,
- );
- }
- else {
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- ALIAS => $cgm_alias,
- FIELD => 'MemberId',
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- QUOTEVALUE => 0,
- ENTRYAGGREGATOR => $ea,
- );
- $self->SUPER::Limit(
- SUBCLAUSE => 'ACL',
- ALIAS => $role_group_alias,
- FIELD => 'Type',
- VALUE => $role,
- ENTRYAGGREGATOR => 'AND',
- );
- }
- $limit_queues->( 'AND', @$queues ) if ref $queues;
- $ea = 'OR' if $ea eq 'AND';
- $self->SUPER::_CloseParen('ACL');
- }
- $self->SUPER::_CloseParen('ACL');
- }
- return $self->{'_sql_current_user_can_see_applied'} = 1;
-}
-
-
-
-
-
-=head2 LoadRestrictions
-
-LoadRestrictions takes a string which can fully populate the TicketRestrictons hash.
-TODO It is not yet implemented
-
-=cut
-
-
-
-=head2 DescribeRestrictions
-
-takes nothing.
-Returns a hash keyed by restriction id.
-Each element of the hash is currently a one element hash that contains DESCRIPTION which
-is a description of the purpose of that TicketRestriction
-
-=cut
-
-sub DescribeRestrictions {
- my $self = shift;
-
- my %listing;
-
- foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) {
- $listing{$row} = $self->{'TicketRestrictions'}{$row}{'DESCRIPTION'};
- }
- return (%listing);
-}
-
-
-
-=head2 RestrictionValues FIELD
-
-Takes a restriction field and returns a list of values this field is restricted
-to.
-
-=cut
-
-sub RestrictionValues {
- my $self = shift;
- my $field = shift;
- map $self->{'TicketRestrictions'}{$_}{'VALUE'}, grep {
- $self->{'TicketRestrictions'}{$_}{'FIELD'} eq $field
- && $self->{'TicketRestrictions'}{$_}{'OPERATOR'} eq "="
- }
- keys %{ $self->{'TicketRestrictions'} };
-}
-
-
-
-=head2 ClearRestrictions
-
-Removes all restrictions irretrievably
-
-=cut
-
-sub ClearRestrictions {
- my $self = shift;
- delete $self->{'TicketRestrictions'};
- $self->{'looking_at_effective_id'} = 0;
- $self->{'looking_at_type'} = 0;
- $self->{'RecalcTicketLimits'} = 1;
-}
-
-
-
-=head2 DeleteRestriction
-
-Takes the row Id of a restriction (From DescribeRestrictions' output, for example.
-Removes that restriction from the session's limits.
-
-=cut
-
-sub DeleteRestriction {
- my $self = shift;
- my $row = shift;
- delete $self->{'TicketRestrictions'}{$row};
-
- $self->{'RecalcTicketLimits'} = 1;
-
- #make the underlying easysearch object forget all its preconceptions
-}
-
-
-
-# Convert a set of oldstyle SB Restrictions to Clauses for RQL
-
-sub _RestrictionsToClauses {
- my $self = shift;
-
- my %clause;
- foreach my $row ( keys %{ $self->{'TicketRestrictions'} } ) {
- my $restriction = $self->{'TicketRestrictions'}{$row};
-
- # We need to reimplement the subclause aggregation that SearchBuilder does.
- # Default Subclause is ALIAS.FIELD, and default ALIAS is 'main',
- # Then SB AND's the different Subclauses together.
-
- # So, we want to group things into Subclauses, convert them to
- # SQL, and then join them with the appropriate DefaultEA.
- # Then join each subclause group with AND.
-
- my $field = $restriction->{'FIELD'};
- my $realfield = $field; # CustomFields fake up a fieldname, so
- # we need to figure that out
-
- # One special case
- # Rewrite LinkedTo meta field to the real field
- if ( $field =~ /LinkedTo/ ) {
- $realfield = $field = $restriction->{'TYPE'};
- }
-
- # Two special case
- # Handle subkey fields with a different real field
- if ( $field =~ /^(\w+)\./ ) {
- $realfield = $1;
- }
-
- die "I don't know about $field yet"
- unless ( exists $FIELD_METADATA{$realfield}
- or $restriction->{CUSTOMFIELD} );
-
- my $type = $FIELD_METADATA{$realfield}->[0];
- my $op = $restriction->{'OPERATOR'};
-
- my $value = (
- grep {defined}
- map { $restriction->{$_} } qw(VALUE TICKET BASE TARGET)
- )[0];
-
- # this performs the moral equivalent of defined or/dor/C<//>,
- # without the short circuiting.You need to use a 'defined or'
- # type thing instead of just checking for truth values, because
- # VALUE could be 0.(i.e. "false")
-
- # You could also use this, but I find it less aesthetic:
- # (although it does short circuit)
- #( defined $restriction->{'VALUE'}? $restriction->{VALUE} :
- # defined $restriction->{'TICKET'} ?
- # $restriction->{TICKET} :
- # defined $restriction->{'BASE'} ?
- # $restriction->{BASE} :
- # defined $restriction->{'TARGET'} ?
- # $restriction->{TARGET} )
-
- my $ea = $restriction->{ENTRYAGGREGATOR}
- || $DefaultEA{$type}
- || "AND";
- if ( ref $ea ) {
- die "Invalid operator $op for $field ($type)"
- unless exists $ea->{$op};
- $ea = $ea->{$op};
- }
-
- # Each CustomField should be put into a different Clause so they
- # are ANDed together.
- if ( $restriction->{CUSTOMFIELD} ) {
- $realfield = $field;
- }
-
- exists $clause{$realfield} or $clause{$realfield} = [];
-
- # Escape Quotes
- $field =~ s!(['\\])!\\$1!g;
- $value =~ s!(['\\])!\\$1!g;
- my $data = [ $ea, $type, $field, $op, $value ];
-
- # here is where we store extra data, say if it's a keyword or
- # something. (I.e. "TYPE SPECIFIC STUFF")
-
- if (lc $ea eq 'none') {
- $clause{$realfield} = [ $data ];
- } else {
- push @{ $clause{$realfield} }, $data;
- }
- }
- return \%clause;
-}
-
-
-
-=head2 _ProcessRestrictions PARAMHASH
-
-# The new _ProcessRestrictions is somewhat dependent on the SQL stuff,
-# but isn't quite generic enough to move into Tickets_SQL.
-
-=cut
-
-sub _ProcessRestrictions {
- my $self = shift;
-
- #Blow away ticket aliases since we'll need to regenerate them for
- #a new search
- delete $self->{'TicketAliases'};
- delete $self->{'items_array'};
- delete $self->{'item_map'};
- delete $self->{'raw_rows'};
- delete $self->{'rows'};
- delete $self->{'count_all'};
-
- my $sql = $self->Query; # Violating the _SQL namespace
- if ( !$sql || $self->{'RecalcTicketLimits'} ) {
-
- # "Restrictions to Clauses Branch\n";
- my $clauseRef = eval { $self->_RestrictionsToClauses; };
- if ($@) {
- $RT::Logger->error( "RestrictionsToClauses: " . $@ );
- $self->FromSQL("");
- }
- else {
- $sql = $self->ClausesToSQL($clauseRef);
- $self->FromSQL($sql) if $sql;
- }
- }
-
- $self->{'RecalcTicketLimits'} = 0;
-
-}
-
-=head2 _BuildItemMap
-
-Build up a L</ItemMap> of first/last/next/prev items, so that we can
-display search nav quickly.
-
-=cut
-
-sub _BuildItemMap {
- my $self = shift;
-
- my $window = RT->Config->Get('TicketsItemMapSize');
-
- $self->{'item_map'} = {};
-
- my $items = $self->ItemsArrayRefWindow( $window );
- return unless $items && @$items;
-
- my $prev = 0;
- $self->{'item_map'}{'first'} = $items->[0]->EffectiveId;
- for ( my $i = 0; $i < @$items; $i++ ) {
- my $item = $items->[$i];
- my $id = $item->EffectiveId;
- $self->{'item_map'}{$id}{'defined'} = 1;
- $self->{'item_map'}{$id}{'prev'} = $prev;
- $self->{'item_map'}{$id}{'next'} = $items->[$i+1]->EffectiveId
- if $items->[$i+1];
- $prev = $id;
- }
- $self->{'item_map'}{'last'} = $prev
- if !$window || @$items < $window;
-}
-
-=head2 ItemMap
-
-Returns an a map of all items found by this search. The map is a hash
-of the form:
-
- {
- first => <first ticket id found>,
- last => <last ticket id found or undef>,
-
- <ticket id> => {
- prev => <the ticket id found before>,
- next => <the ticket id found after>,
- },
- <ticket id> => {
- prev => ...,
- next => ...,
- },
- }
-
-=cut
-
-sub ItemMap {
- my $self = shift;
- $self->_BuildItemMap unless $self->{'item_map'};
- return $self->{'item_map'};
-}
-
-
-
-
-=head2 PrepForSerialization
-
-You don't want to serialize a big tickets object, as
-the {items} hash will be instantly invalid _and_ eat
-lots of space
-
-=cut
-
-sub PrepForSerialization {
- my $self = shift;
- delete $self->{'items'};
- delete $self->{'items_array'};
- $self->RedoSearch();
-}
-
-=head1 FLAGS
-
-RT::Tickets supports several flags which alter search behavior:
-
-
-allow_deleted_search (Otherwise never show deleted tickets in search results)
-looking_at_type (otherwise limit to type=ticket)
-
-These flags are set by calling
-
-$tickets->{'flagname'} = 1;
-
-BUG: There should be an API for this
-
-
-
-=cut
-
-
-
-=head2 NewItem
-
-Returns an empty new RT::Ticket item
-
-=cut
-
-sub NewItem {
- my $self = shift;
- return(RT::Ticket->new($self->CurrentUser));
-}
-RT::Base->_ImportOverlays();
-
-1;
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', );
-
-my $id = shift;
-
-if ( $opt{help} || !$id ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
-
-require RT::Attribute;
-my $attr = RT::Attribute->new( RT->SystemUser );
-$attr->Load( $id );
-unless ( $attr->id ) {
- print STDERR "Couldn't load attribute #$id\n";
- exit 1;
-}
-
-my %res = ();
-$res{$_} = $attr->$_() foreach qw(ObjectType ObjectId Name Description Content ContentType);
-
-use Data::Dumper;
-print "Content of attribute #$id: ". Dumper( \%res );
-
-__END__
-
-=head1 NAME
-
-rt-attributes-viewer - show the content of an attribute
-
-=head1 SYNOPSIS
-
- # show the content of attribute 2
- rt-attributes-viewer 2
-
-=head1 DESCRIPTION
-
-This script deserializes and print content of an attribute defined
-by <attribute id>. May be useful for developers and for troubleshooting
-problems.
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, "older=s", "debug", "help|h", "skip-user" );
-
-
-if ( $opt{help} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-
-if( $opt{'older'} ) {
- unless( $opt{'older'} =~ /^\s*([0-9]+)\s*(H|D|M|Y)?$/i ) {
- print STDERR "wrong format of the 'older' argumnet\n";
- exit(1);
- }
- my ($num,$unit) = ($1, uc($2 ||'D'));
- my %factor = ( H => 60*60 );
- $factor{'D'} = $factor{'H'}*24;
- $factor{'M'} = $factor{'D'}*31;
- $factor{'Y'} = $factor{'D'}*365;
- $opt{'older'} = $num * $factor{ $unit };
-}
-
-require RT;
-RT::LoadConfig();
-
-if( $opt{'debug'} ) {
- RT->Config->Set( LogToScreen => 'debug' );
-} else {
- RT->Config->Set( LogToScreen => undef );
-}
-
-RT::ConnectToDatabase();
-RT::InitLogging();
-
-require RT::Interface::Web::Session;
-
-my $alogoff = int RT->Config->Get('AutoLogoff');
-if ( $opt{'older'} or $alogoff ) {
- my $min;
- foreach ($alogoff*60, $opt{'older'}) {
- next unless $_;
- $min = $_ unless $min;
- $min = $_ if $_ < $min;
- }
-
- RT::Interface::Web::Session->ClearOld( $min );
-}
-
-RT::Interface::Web::Session->ClearByUser
- unless $opt{'skip-user'};
-
-exit(0);
-
-__END__
-
-=head1 NAME
-
-rt-clean-sessions - clean old and duplicate RT sessions
-
-=head1 SYNOPSIS
-
- rt-clean-sessions [--debug] [--older <NUM>[H|D|M|Y]]
-
- rt-clean-sessions
- rt-clean-sessions --debug
- rt-clean-sessions --older 10D
- rt-clean-sessions --debug --older 1M
- rt-clean-sessions --older 10D --skip-user
-
-=head1 DESCRIPTION
-
-Script cleans RT sessions from DB or dir with sessions data.
-Leaves in DB only one session per RT user and sessions that aren't older
-than specified(see options).
-
-Script is safe because data in the sessions is temporary and can be deleted.
-
-=head1 OPTIONS
-
-=over 4
-
-=item older
-
-Date interval in the C<< <NUM>[<unit>] >> format. Default unit is D(ays),
-H(our), M(onth) and Y(ear) are also supported.
-
-For example: C<rt-clean-sessions --older 1M> would delete all sessions that are
-older than 1 month.
-
-=item skip-user
-
-By default only one session per user left in the DB, so users that have
-sessions on multiple computers or in different browsers will be logged out.
-Use this option to avoid this.
-
-=item debug
-
-Turn on debug output.
-
-=back
-
-=head1 NOTES
-
-Functionality similar to this is implemented in
-html/Elements/SetupSessionCookie ; however, that does not guarantee
-that a session will be removed from disk and database soon after the
-timeout expires. This script, if run from a cron job, will ensure
-that the timed out sessions are actually removed from disk; the Mason
-component just ensures that the old sessions are not reusable before
-the cron job gets to them.
-
-=cut
+++ /dev/null
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# As we specify that XML is UTF-8 and we output it to STDOUT, we must be sure
-# it is UTF-8 so further XMLin will not break
-binmode( STDOUT, ":utf8" );
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ( "/opt/rt3/lib", "/opt/rt3/local/lib" );
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- } else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, "help|h",
- "limit-to-privileged|l",
- "skip-disabled|s",
- "all|a",
-);
-
-if ( $opt{help} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-require RT;
-require XML::Simple;
-
-RT::LoadConfig();
-RT::Init();
-
-my %RV;
-my %Ignore = (
- All => [
- qw(
- id Created Creator LastUpdated LastUpdatedBy
- )
- ],
- Templates => [
- qw(
- TranslationOf
- )
- ],
-);
-
-my $SystemUserId = RT->SystemUser->Id;
-my @classes = qw(
- Users Groups Queues ScripActions ScripConditions
- Templates Scrips ACL CustomFields
- );
-foreach my $class (@classes) {
- require "RT/$class.pm";
- my $objects = "RT::$class"->new( RT->SystemUser );
- $objects->{find_disabled_rows} = 1 unless $opt{'skip-disabled'};
- $objects->UnLimit;
- $objects->LimitToPrivileged if $class eq 'Users'
- && $opt{'limit-to-privileged'};
- $objects->Limit(
- FIELD => 'Domain',
- OPERATOR => '=',
- VALUE => 'UserDefined'
- ) if $class eq 'Groups';
-
- if ( $class eq 'CustomFields' ) {
- $objects->OrderByCols(
- { FIELD => 'LookupType' },
- { FIELD => 'SortOrder' },
- { FIELD => 'Id' },
- );
- } else {
- $objects->OrderBy( FIELD => 'Id' );
- }
-
- unless ($opt{all}) {
- next if $class eq 'ACL'; # XXX - would go into infinite loop - XXX
- $objects->Limit(
- FIELD => 'LastUpdatedBy',
- OPERATOR => '!=',
- VALUE => $SystemUserId
- ) unless $class eq 'Groups';
- $objects->Limit(
- FIELD => 'Id',
- OPERATOR => '!=',
- VALUE => $SystemUserId
- ) if $class eq 'Users';
- }
-
- my %fields;
-OBJECT:
- while ( my $obj = $objects->Next ) {
- next
- if $obj->can('LastUpdatedBy')
- and $obj->LastUpdatedBy == $SystemUserId;
-
- if ( !%fields ) {
- %fields = map { $_ => 1 } keys %{ $obj->_ClassAccessible };
- delete @fields{ @{ $Ignore{$class} ||= [] },
- @{ $Ignore{All} ||= [] }, };
- }
-
- my $rv;
-
- if ( $class ne 'ACL' ) {
- # next if $obj-> # skip default names
- foreach my $field ( sort keys %fields ) {
- my $value = $obj->__Value($field);
- $rv->{$field} = $value if ( defined($value) && length($value) );
- }
- delete $rv->{Disabled} unless $rv->{Disabled};
-
- foreach my $record ( map { /ACL/ ? 'ACE' : substr( $_, 0, -1 ) }
- @classes )
- {
- foreach my $key ( map "$record$_", ( '', 'Id' ) ) {
- next unless exists $rv->{$key};
- my $id = $rv->{$key} or next;
- my $obj = "RT::$record"->new( RT->SystemUser );
- $obj->LoadByCols( Id => $id ) or next;
- $rv->{$key} = $obj->__Value('Name') || 0;
- }
- }
-
- if ( $class eq 'Users' and defined $obj->Privileged ) {
- $rv->{Privileged} = int( $obj->Privileged );
- } elsif ( $class eq 'CustomFields' ) {
- my $values = $obj->Values;
- while ( my $value = $values->Next ) {
- push @{ $rv->{Values} }, {
- map { ( $_ => $value->__Value($_) ) }
- qw(
- Name Description SortOrder
- ),
- };
- }
- if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) {
- # XXX-TODO: unused CF's turn into global CF when importing
- # as the sub InsertData in RT::Handle creates a global CF
- # when no queue is specified.
- $rv->{Queue} = [];
- my $applies = $obj->AppliedTo;
- while ( my $queue = $applies->Next ) {
- push @{ $rv->{Queue} }, $queue->Name;
- }
- }
- }
- }
- else {
- # 1) pick the right
- $rv->{Right} = $obj->RightName;
-
- # 2) Pick a level: Granted on Queue, CF, CF+Queue, or Globally?
- for ( $obj->ObjectType ) {
- if ( /^RT::Queue$/ ) {
- next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled;
- $rv->{Queue} = $obj->Object->Name;
- }
- elsif ( /^RT::CustomField$/ ) {
- next OBJECT if $opt{'skip-disabled'} && $obj->Object->Disabled;
- $rv->{CF} = $obj->Object->Name;
- }
- elsif ( /^RT::Group$/ ) {
- # No support for RT::Group ACLs in RT::Handle yet.
- next OBJECT;
- }
- elsif ( /^RT::System$/ ) {
- # skip setting anything on $rv;
- # "Specifying none of the above will get you a global right."
- }
- }
-
- # 3) Pick a Principal; User or Group or Role
- if ( $obj->PrincipalType eq 'Group' ) {
- next OBJECT if $opt{'skip-disabled'} && $obj->PrincipalObj->Disabled;
- my $group = $obj->PrincipalObj->Object;
- for ( $group->Domain ) {
- # An internal user group
- if ( /^SystemInternal$/ ) {
- $rv->{GroupDomain} = $group->Domain;
- $rv->{GroupType} = $group->Type;
- }
- # An individual user
- elsif ( /^ACLEquivalence$/ ) {
- my $member = $group->MembersObj->Next->MemberObj;
- next OBJECT if $opt{'skip-disabled'} && $member->Disabled;
- $rv->{UserId} = $member->Object->Name;
- }
- # A group you created
- elsif ( /^UserDefined$/ ) {
- $rv->{GroupDomain} = 'UserDefined';
- $rv->{GroupId} = $group->Name;
- }
- }
- } else {
- $rv->{GroupType} = $obj->PrincipalType;
- # A system-level role
- if ( $obj->ObjectType eq 'RT::System' ) {
- $rv->{GroupDomain} = 'RT::System-Role';
- }
- # A queue-level role
- elsif ( $obj->ObjectType eq 'RT::Queue' ) {
- $rv->{GroupDomain} = 'RT::Queue-Role';
- }
- }
- if ( $obj->LookupType eq 'RT::Queue-RT::Ticket' ) {
- # XXX-TODO: unused CF's turn into global CF when importing
- # as the sub InsertData in RT::Handle creates a global CF
- # when no queue is specified.
- $rv->{Queue} = [];
- my $applies = $obj->AppliedTo;
- while ( my $queue = $applies->Next ) {
- push @{ $rv->{Queue} }, $queue->Name;
- }
- }
- }
-
- if ( eval { require RT::Attributes; 1 } ) {
- my $attributes = $obj->Attributes;
- while ( my $attribute = $attributes->Next ) {
- my $content = $attribute->Content;
- if ( $class eq 'Users' and $attribute->Name eq 'Bookmarks' ) {
- next;
- }
- $rv->{Attributes}{ $attribute->Name } = $content
- if length($content);
- }
- }
-
- push @{ $RV{$class} }, $rv;
- }
-}
-
-print(<< ".");
-no strict; use XML::Simple; *_ = XMLin(do { local \$/; readline(DATA) }, ForceArray => [qw(
- @classes Values
-)], NoAttr => 1, SuppressEmpty => ''); *\$_ = (\$_{\$_} || []) for keys \%_; 1; # vim: ft=xml
-__DATA__
-.
-
-print XML::Simple::XMLout(
- { map { ( $_ => ( $RV{$_} || [] ) ) } @classes },
- RootName => 'InitialData',
- NoAttr => 1,
- SuppressEmpty => '',
- XMLDecl => '<?xml version="1.0" encoding="UTF-8"?>',
-);
-
-__END__
-
-=head1 NAME
-
-rt-dump-metadata - dump configuration metadata from an RT database
-
-=head1 SYNOPSIS
-
- rt-dump-metdata [--all]
-
-=head1 DESCRIPTION
-
-C<rt-dump-metadata> is a tool that dumps configuration metadata from the
-Request Tracker database into XML format, suitable for feeding into
-C<rt-setup-database>. To dump and load a full RT database, you should generally
-use the native database tools instead, as well as performing any necessary
-steps from UPGRADING.
-
-This is NOT a tool for backing up an RT database. See also
-L<docs/initialdata> for more straightforward means of importing data.
-
-=head1 OPTIONS
-
-=over
-
-=item C<--all> or C<-a>
-
-When run with C<--all>, the dump will include all configuration
-metadata; otherwise, the metadata dump will only include 'local'
-configuration changes, i.e. those done manually in the web interface.
-
-=item C<--limit-to-privileged> or C<-l>
-
-Causes the dumper to only dump privileged users.
-
-=item C<--skip-disabled> or C<-s>
-
-Ignores disabled rows in the database.
-
-=back
-
-=cut
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-# Read in the options
-my %opts;
-use Getopt::Long;
-GetOptions( \%opts,
- "help|h", "dryrun", "time=i", "epoch=i", "all"
-);
-
-if ($opts{'help'}) {
- require Pod::Usage;
- print Pod::Usage::pod2usage(-verbose => 2);
- exit;
-}
-
-require RT;
-require RT::Interface::CLI;
-RT::Interface::CLI->import(qw{ CleanEnv loc });
-
-# Clean out all the nasties from the environment
-CleanEnv();
-
-# Load the config file
-RT::LoadConfig();
-
-# Connect to the database and get RT::SystemUser and RT::Nobody loaded
-RT::Init();
-
-require RT::Dashboard::Mailer;
-RT::Dashboard::Mailer->MailDashboards(
- All => $opts{all},
- DryRun => $opts{dryrun},
- Time => ($opts{time} || $opts{epoch} || time), # epoch is the old-style
- Opts => \%opts,
-);
-
-=head1 NAME
-
-rt-email-dashboards - Send email dashboards
-
-=head1 SYNOPSIS
-
- rt-email-dashboards [options]
-
-=head1 DESCRIPTION
-
-This tool will send users email based on how they have subscribed to
-dashboards. A dashboard is a set of saved searches, the subscription controls
-how often that dashboard is sent and how it's displayed.
-
-Each subscription has an hour, and possibly day of week or day of month. These
-are taken to be in the user's timezone if available, UTC otherwise.
-
-=head1 SETUP
-
-You'll need to have cron run this script every hour. Here's an example crontab
-entry to do this.
-
- 0 * * * * /usr/bin/perl /opt/rt4/local/sbin/rt-email-dashboards
-
-This will run the script every hour on the hour. This may need some further
-tweaking to be run as the correct user.
-
-=head1 OPTIONS
-
-This tool supports a few options. Most are for debugging.
-
-=over 8
-
-=item -h
-
-=item --help
-
-Display this documentation
-
-=item --dryrun
-
-Figure out which dashboards would be sent, but don't actually generate or email
-any of them
-
-=item --time SECONDS
-
-Instead of using the current time to figure out which dashboards should be
-sent, use SECONDS (usually since midnight Jan 1st, 1970, so C<1192216018> would
-be Oct 12 19:06:58 GMT 2007).
-
-=item --epoch SECONDS
-
-Back-compat for --time SECONDS.
-
-=item --all
-
-Ignore subscription frequency when considering each dashboard (should only be
-used with --dryrun for testing and debugging)
-
-=back
-
-=cut
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Date::Format qw( strftime );
-use Getopt::Long;
-use RT;
-use RT::Interface::CLI qw( CleanEnv loc );
-use RT::Interface::Email;
-
-CleanEnv();
-RT::LoadConfig();
-RT::Init();
-
-sub usage {
- my ($error) = @_;
- print loc("Usage:") . " $0 -m (daily|weekly) [--print] [--help]\n";
- print loc(
- "[_1] is a utility, meant to be run from cron, that dispatches all deferred RT notifications as a per-user digest.",
- $0
- ) . "\n";
- print "\n\t-m, --mode\t"
- . loc("Specify whether this is a daily or weekly run.") . "\n";
- print "\t-p, --print\t"
- . loc("Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent")
- . "\n";
- print "\t-v, --verbose\t" . loc("Give output even on messages successfully sent") . "\n";
- print "\t-h, --help\t" . loc("Print this message") . "\n";
-
- if ( $error eq 'help' ) {
- exit 0;
- } else {
- print loc("Error") . ": " . loc($error) . "\n";
- exit 1;
- }
-}
-
-my ( $frequency, $print, $verbose, $help ) = ( '', '', '', '' );
-GetOptions(
- 'mode=s' => \$frequency,
- 'print' => \$print,
- 'verbose' => \$verbose,
- 'help' => \$help,
-);
-
-usage('help') if $help;
-usage("Mode argument must be 'daily' or 'weekly'")
- unless $frequency =~ /^(daily|weekly)$/;
-
-run( $frequency, $print );
-
-sub run {
- my $frequency = shift;
- my $print = shift;
-
-## Find all the tickets that have been modified within the time frame
-## described by $frequency.
-
- my ( $all_digest, $sent_transactions ) = find_transactions($frequency);
-
-## Iterate through our huge hash constructing the digest message
-## for each user and sending it.
-
- foreach my $user ( keys %$all_digest ) {
- my ( $contents_list, $contents_body ) = build_digest_for_user( $user, $all_digest->{$user} );
- # Now we have a content head and a content body. We can send a message.
- if ( send_digest( $user, $contents_list, $contents_body ) ) {
- print "Sent message to $user\n" if $verbose;
- mark_transactions_sent( $frequency, $user, values %{$sent_transactions->{$user}} ) unless ($print);
- } else {
- print "Failed to send message to $user\n";
- }
- }
-}
-exit 0;
-
-# Subroutines.
-
-sub send_digest {
- my ( $to, $index, $messages ) = @_;
-
- # Combine the index and the messages.
-
- my $body = "============== Tickets with activity in the last "
- . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
-
- $body .= $index;
- $body .= "\n\n============== Messages recorded in the last "
- . ( $frequency eq 'daily' ? "day" : "seven days" ) . "\n\n";
- $body .= $messages;
-
- # Load our template. If we cannot load the template, abort
- # immediately rather than failing through many loops.
- my $digest_template = RT::Template->new( RT->SystemUser );
- my ( $ret, $msg ) = $digest_template->Load('Email Digest');
- unless ($ret) {
- print loc("Failed to load template")
- . " 'Email Digest': "
- . $msg
- . ". Cannot continue.\n";
- exit 1;
- }
- ( $ret, $msg ) = $digest_template->Parse( Argument => $body );
- unless ($ret) {
- print loc("Failed to parse template")
- . " 'Email Digest'. Cannot continue.\n";
- exit 1;
- }
-
- # Set our sender and recipient.
- $digest_template->MIMEObj->head->replace(
- 'From', Encode::encode( "UTF-8", RT::Config->Get('CorrespondAddress') ) );
- $digest_template->MIMEObj->head->replace(
- 'To', Encode::encode( "UTF-8", $to ) );
-
- if ($print) {
- $digest_template->MIMEObj->print;
- return 1;
- } else {
- return RT::Interface::Email::SendEmail( Entity => $digest_template->MIMEObj)
- }
-}
-
-# =item mark_transactions_sent( $frequency, $user, @txn_list );
-#
-# Takes a frequency string (either 'daily' or 'weekly'), a user and one or more
-# transaction objects as its arguments. Marks the given deferred
-# notifications as sent.
-#
-# =cut
-
-sub mark_transactions_sent {
- my ( $freq, $user, @txns ) = @_;
- return unless $freq =~ /(daily|weekly)/;
- return unless @txns;
- foreach my $txn (@txns) {
-
- # Grab the attribute, mark the "sent" as true, and store the new
- # value.
- if ( my $attr = $txn->FirstAttribute('DeferredRecipients') ) {
- my $deferred = $attr->Content;
- $deferred->{$freq}->{$user}->{'_sent'} = 1;
- $txn->SetAttribute(
- Name => 'DeferredRecipients',
- Description => 'Deferred recipients for this message',
- Content => $deferred,
- );
- }
- }
-}
-
-sub since_date {
- my $frequency = shift;
-
- # Specify a short time for digest overlap, in case we aren't starting
- # this process exactly on time.
- my $OVERLAP_HEDGE = -30;
-
- my $since_date = RT::Date->new( RT->SystemUser );
- $since_date->Set( Format => 'unix', Value => time() );
- if ( $frequency eq 'daily' ) {
- $since_date->AddDays(-1);
- } else {
- $since_date->AddDays(-7);
- }
-
- $since_date->AddSeconds($OVERLAP_HEDGE);
-
- return $since_date;
-}
-
-sub find_transactions {
- my $frequency = shift;
- my $since_date = since_date($frequency);
-
- my $txns = RT::Transactions->new( RT->SystemUser );
-
- # First limit to recent transactions.
- $txns->Limit(
- FIELD => 'Created',
- OPERATOR => '>',
- VALUE => $since_date->ISO
- );
-
- # Next limit to ticket transactions.
- $txns->Limit(
- FIELD => 'ObjectType',
- OPERATOR => '=',
- VALUE => 'RT::Ticket',
- ENTRYAGGREGATOR => 'AND'
- );
- my $all_digest = {};
- my $sent_transactions = {};
-
- while ( my $txn = $txns->Next ) {
- my $ticket = $txn->Ticket;
- my $queue = $txn->TicketObj->QueueObj->Name;
- # Xxx todo - may clobber if two queues have the same name
- foreach my $user ( $txn->DeferredRecipients($frequency) ) {
- $all_digest->{$user}->{$queue}->{$ticket}->{ $txn->id } = $txn->ContentObj;
- $sent_transactions->{$user}->{ $txn->id } = $txn;
- }
- }
-
- return ( $all_digest, $sent_transactions );
-}
-
-sub build_digest_for_user {
- my $user = shift;
- my $user_digest = shift;
-
- my $contents_list = ''; # Holds the digest index.
- my $contents_body = ''; # Holds the digest body.
-
- # Has the user been disabled since a message was deferred on his/her
- # behalf?
- my $user_obj = RT::User->new( RT->SystemUser );
- $user_obj->LoadByEmail($user);
- if ( $user_obj->PrincipalObj->Disabled ) {
- print STDERR loc("Skipping disabled user") . " $user\n";
- next;
- }
-
- print loc("Message for user") . " $user:\n\n" if $print;
- foreach my $queue ( keys %$user_digest ) {
- $contents_list .= "Queue $queue:\n";
- $contents_body .= "Queue $queue:\n";
- foreach my $ticket ( sort keys %{ $user_digest->{$queue} } ) {
- my $tkt_txns = $user_digest->{$queue}->{$ticket};
- my $ticket_obj = RT::Ticket->new( RT->SystemUser );
- $ticket_obj->Load($ticket);
-
- # Spit out the index entry for this ticket.
- my $ticket_title = sprintf(
- "#%d %s [%s]\t%s\n",
- $ticket, $ticket_obj->Status, $ticket_obj->OwnerObj->Name,
- $ticket_obj->Subject
- );
- $contents_list .= $ticket_title;
-
- # Spit out the messages for the transactions on this ticket.
- $contents_body .= "\n== $ticket_title\n";
- foreach my $txn ( sort keys %$tkt_txns ) {
- my $msg = $tkt_txns->{$txn};
-
- # $msg contains an RT::Attachment with our outgoing
- # message. Print a few headers for clarity's sake.
- $contents_body .= "From: " . $msg->GetHeader('From') . "\n";
- my $date = $msg->GetHeader('Date ');
- unless ($date) {
- my $txn_obj = RT::Transaction->new( RT->SystemUser );
- $txn_obj->Load($txn);
- my $date_obj = RT::Date->new( RT->SystemUser );
- $date_obj->Set(
- Format => 'sql',
- Value => $txn_obj->Created
- );
- $date = strftime( '%a, %d %b %Y %H:%M:%S %z',
- @{ [ localtime( $date_obj->Unix ) ] } );
- }
- $contents_body .= "Date: $date\n\n";
- $contents_body .= $msg->Content . "\n";
- $contents_body .= "-------\n";
- } # foreach transaction
- } # foreach ticket
- } # foreach queue
-
- return ( $contents_list, $contents_body );
-
-}
-
-__END__
-
-=head1 NAME
-
-rt-email-digest - dispatch deferred notifications as a per-user digest
-
-=head1 SYNOPSIS
-
- rt-email-digest -m (daily|weekly) [--print] [--help]
-
-=head1 DESCRIPTION
-
-This script is a tool to dispatch all deferred RT notifications as a per-user
-object.
-
-=head1 OPTIONS
-
-=over
-
-=item mode
-
-Specify whether this is a daily or weekly run.
-
---mode is equal to -m
-
-=item print
-
-Print the resulting digest messages to STDOUT; don't mail them. Do not mark them as sent
-
---print is equal to -p
-
-=item help
-
-Print this message
-
---help is equal to -h
-
-=back
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-=head1 NAME
-
-rt-email-group-admin - Command line tool for administrating NotifyGroup actions
-
-=head1 SYNOPSIS
-
- rt-email-group-admin --list
- rt-email-group-admin --create 'Notify foo team' --group Foo
- rt-email-group-admin --create 'Notify foo team as comment' --comment --group Foo
- rt-email-group-admin --create 'Notify group Foo and Bar' --group Foo --group Bar
- rt-email-group-admin --create 'Notify user foo@bar.com' --user foo@bar.com
- rt-email-group-admin --create 'Notify VIPs' --user vip1@bar.com
- rt-email-group-admin --add 'Notify VIPs' --user vip2@bar.com --group vip1 --user vip3@foo.com
- rt-email-group-admin --rename 'Notify VIPs' --newname 'Inform VIPs'
- rt-email-group-admin --switch 'Notify VIPs'
- rt-email-group-admin --delete 'Notify user foo@bar.com'
-
-=head1 DESCRIPTION
-
-This script list, create, modify or delete scrip actions in the RT DB. Once
-you've created an action you can use it in a scrip.
-
-For example you can create the following action using this script:
-
- rt-email-group-admin --create 'Notify developers' --group 'Development Team'
-
-Then you can add the followoing scrip to your Bugs queue:
-
- Condition: On Create
- Action: Notify developers
- Template: Transaction
- Stage: TransactionCreate
-
-Your development team will be notified on every new ticket in the queue.
-
-=cut
-
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long qw(GetOptions);
-Getopt::Long::Configure( "pass_through" );
-
-our $cmd = 'usage';
-our $opts = {};
-
-sub parse_args {
- my $tmp;
- if ( GetOptions( 'list' => \$tmp ) && $tmp ) {
- $cmd = 'list';
- }
- elsif ( GetOptions( 'create=s' => \$tmp ) && $tmp ) {
- $cmd = 'create';
- $opts->{'name'} = $tmp;
- $opts->{'groups'} = [];
- $opts->{'users'} = [];
- GetOptions( 'comment' => \$opts->{'comment'} );
- GetOptions( 'group:s@' => $opts->{'groups'} );
- GetOptions( 'user:s@' => $opts->{'users'} );
- unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
- usage();
- exit(-1);
- }
- }
- elsif ( GetOptions( 'add=s' => \$tmp ) && $tmp ) {
- $cmd = 'add';
- $opts->{'name'} = $tmp;
- $opts->{'groups'} = [];
- $opts->{'users'} = [];
- GetOptions( 'group:s@' => $opts->{'groups'} );
- GetOptions( 'user:s@' => $opts->{'users'} );
- unless ( @{ $opts->{'users'} } + @{ $opts->{'groups'} } ) {
- usage();
- exit(-1);
- }
- }
- elsif ( GetOptions( 'switch=s' => \$tmp ) && $tmp ) {
- $cmd = 'switch';
- $opts->{'name'} = $tmp;
- }
- elsif ( GetOptions( 'rename=s' => \$tmp ) && $tmp ) {
- $cmd = 'rename';
- $opts->{'name'} = $tmp;
- GetOptions( 'newname=s' => \$opts->{'newname'} );
- unless ( $opts->{'newname'} ) {
- usage();
- exit(-1);
- }
- }
- elsif ( GetOptions( 'delete=s' => \$tmp ) && $tmp) {
- $cmd = 'delete';
- $opts->{'name'} = $tmp;
- } else {
- $cmd = 'usage';
- }
-
- return;
-}
-
-sub usage {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
-}
-
-my $help;
-if ( GetOptions( 'help|h' => \$help ) && $help ) {
- usage();
- exit;
-}
-
-parse_args();
-
-require RT;
-RT->LoadConfig;
-RT->Init;
-
-require RT::Principal;
-require RT::User;
-require RT::Group;
-require RT::ScripActions;
-
-
-{
- eval "main::$cmd()";
- if ( $@ ) {
- print STDERR $@ ."\n";
- }
-}
-
-exit(0);
-
-=head1 USAGE
-
-rt-email-group-admin --COMMAND ARGS
-
-=head1 COMMANDS
-
-=head2 list
-
-Lists actions and its descriptions.
-
-=cut
-
-sub list {
- my $actions = _get_our_actions();
- while( my $a = $actions->Next ) {
- _list( $a );
- }
- return;
-}
-
-sub _list {
- my $action = shift;
-
- print "Name: ". $action->Name() ."\n";
- print "Module: ". $action->ExecModule() ."\n";
-
- my @princ = argument_to_list( $action );
-
- print "Members: \n";
- foreach( @princ ) {
- my $obj = RT::Principal->new( RT->SystemUser );
- $obj->Load( $_ );
- next unless $obj->id;
-
- print "\t". $obj->PrincipalType;
- print "\t=> ". $obj->Object->Name;
- print "(Disabled!!!)" if $obj->Disabled;
- print "\n";
- }
- print "\n";
- return;
-}
-
-=head2 create NAME [--comment] [--group GNAME] [--user NAME-OR-EMAIL]
-
-Creates new action with NAME and adds users and/or groups to its
-recipient list. Would be notify as comment if --comment specified. The
-user, if specified, will be autocreated if necessary.
-
-=cut
-
-sub create {
- my $actions = RT::ScripActions->new( RT->SystemUser );
- $actions->Limit(
- FIELD => 'Name',
- VALUE => $opts->{'name'},
- );
- if ( $actions->Count ) {
- print STDERR "ScripAction '". $opts->{'name'} ."' allready exists\n";
- exit(-1);
- }
-
- my @groups = _check_groups( @{ $opts->{'groups'} } );
- my @users = _check_users( @{ $opts->{'users'} } );
- unless ( @users + @groups ) {
- print STDERR "List of groups and users is empty\n";
- exit(-1);
- }
-
- my $action = __create_empty( $opts->{'name'}, $opts->{'comment'} );
-
- __add( $action, $_ ) foreach( @users );
- __add( $action, $_ ) foreach( @groups );
-
- return;
-}
-
-sub __create_empty {
- my $name = shift;
- my $as_comment = shift || 0;
- require RT::ScripAction;
- my $action = RT::ScripAction->new( RT->SystemUser );
- $action->Create(
- Name => $name,
- Description => "Created with rt-email-group-admin script",
- ExecModule => $as_comment? 'NotifyGroupAsComment': 'NotifyGroup',
- Argument => '',
- );
-
- return $action;
-}
-
-sub _check_groups
-{
- return map {$_->[1]}
- grep { $_->[1] ? 1: do { print STDERR "Group '$_->[0]' skipped, doesn't exist\n"; 0; } }
- map { [$_, __check_group($_)] } @_;
-}
-
-sub __check_group
-{
- my $instance = shift;
- require RT::Group;
- my $obj = RT::Group->new( RT->SystemUser );
- $obj->LoadUserDefinedGroup( $instance );
- return $obj->id ? $obj : undef;
-}
-
-sub _check_users
-{
- return map {$_->[1]}
- grep { $_->[1] ? 1: do { print STDERR "User '$_->[0]' skipped, doesn't exist and couldn't autocreate\n"; 0; } }
- map { [$_, __check_user($_)] } @_;
-}
-
-sub __check_user
-{
- my $instance = shift;
- require RT::User;
- my $obj = RT::User->new( RT->SystemUser );
- $obj->Load( $instance );
- $obj->LoadByEmail( $instance )
- if not $obj->id and $instance =~ /@/;
-
- unless ($obj->id) {
- my ($ok, $msg) = $obj->Create(
- Name => $instance,
- EmailAddress => $instance,
- Privileged => 0,
- Comments => 'Autocreated when added to notify action via rt-email-group-admin',
- );
- print STDERR "Autocreate of user '$instance' failed: $msg\n"
- unless $ok;
- }
-
- return $obj->id ? $obj : undef;
-}
-
-=head2 add NAME [--group GNAME] [--user NAME-OR-EMAIL]
-
-Adds groups and/or users to recipients of the action NAME. The user, if
-specified, will be autocreated if necessary.
-
-=cut
-
-sub add {
- my $action = _get_action_by_name( $opts->{'name'} );
- unless ( $action ) {
- print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
- exit(-1);
- }
-
- my @groups = _check_groups( @{ $opts->{'groups'} } );
- my @users = _check_users( @{ $opts->{'users'} } );
-
- unless ( @users + @groups ) {
- print STDERR "List of groups and users is empty\n";
- exit(-1);
- }
-
- __add( $action, $_ ) foreach @users;
- __add( $action, $_ ) foreach @groups;
-
- return;
-}
-
-sub __add
-{
- my $action = shift;
- my $obj = shift;
-
- my @cur = argument_to_list( $action );
-
- my $id = $obj->id;
- return if grep $_ == $id, @cur;
-
- push @cur, $id;
-
- return $action->__Set( Field => 'Argument', Value => join(',', @cur) );
-}
-
-=head2 delete NAME
-
-Deletes action NAME if scrips doesn't use it.
-
-=cut
-
-sub delete {
- my $action = _get_action_by_name( $opts->{'name'} );
- unless ( $action ) {
- print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
- exit(-1);
- }
-
- require RT::Scrips;
- my $scrips = RT::Scrips->new( RT->SystemUser );
- $scrips->Limit( FIELD => 'ScripAction', VALUE => $action->id );
- if ( $scrips->Count ) {
- my @sid;
- while( my $s = $scrips->Next ) {
- push @sid, $s->id;
- }
- print STDERR "ScripAction '". $opts->{'name'} ."'"
- . " is in use by Scrip(s) ". join( ", ", map "#$_", @sid )
- . "\n";
- exit(-1);
- }
-
- return __delete( $action );
-}
-
-sub __delete {
- require DBIx::SearchBuilder::Record;
- return DBIx::SearchBuilder::Record::Delete( shift );
-}
-
-sub _get_action_by_name {
- my $name = shift;
- my $actions = _get_our_actions();
- $actions->Limit(
- FIELD => 'Name',
- VALUE => $name
- );
-
- if ( $actions->Count > 1 ) {
- print STDERR "More then one ScripAction with name '$name'\n";
- }
-
- return $actions->First;
-}
-
-=head2 switch NAME
-
-Switch action NAME from notify as correspondence to comment and back.
-
-=cut
-
-sub switch {
- my $action = _get_action_by_name( $opts->{'name'} );
- unless ( $action ) {
- print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
- exit(-1);
- }
-
- my %h = (
- NotifyGroup => 'NotifyGroupAsComment',
- NotifyGroupAsComment => 'NotifyGroup'
- );
-
- return $action->__Set(
- Field => 'ExecModule',
- Value => $h{ $action->ExecModule }
- );
-}
-
-=head2 rename NAME --newname NEWNAME
-
-Renames action NAME to NEWNAME.
-
-=cut
-
-sub rename {
- my $action = _get_action_by_name( $opts->{'name'} );
- unless ( $action ) {
- print STDERR "ScripAction '". $opts->{'name'} ."' doesn't exist\n";
- exit(-1);
- }
-
- my $actions = RT::ScripActions->new( RT->SystemUser );
- $actions->Limit( FIELD => 'Name', VALUE => $opts->{'newname'} );
- if ( $actions->Count ) {
- print STDERR "ScripAction '". $opts->{'newname'} ."' allready exists\n";
- exit(-1);
- }
-
- return $action->__Set(
- Field => 'Name',
- Value => $opts->{'newname'},
- );
-}
-
-=head2 NOTES
-
-If command has option --group or --user then you can use it more then once,
-if other is not specified.
-
-=cut
-
-###############
-#### Utils ####
-###############
-
-sub argument_to_list {
- my $action = shift;
- require RT::Action::NotifyGroup;
- return RT::Action::NotifyGroup->__SplitArg( $action->Argument );
-}
-
-sub _get_our_actions {
- my $actions = RT::ScripActions->new( RT->SystemUser );
- $actions->Limit(
- FIELD => 'ExecModule',
- VALUE => 'NotifyGroup',
- ENTRYAGGREGATOR => 'OR',
- );
- $actions->Limit(
- FIELD => 'ExecModule',
- VALUE => 'NotifyGroupAsComment',
- ENTRYAGGREGATOR => 'OR',
- );
-
- return $actions;
-}
-
-=head1 AUTHOR
-
-Ruslan U. Zakirov E<lt>ruz@bestpractical.comE<gt>
-
-=head1 SEE ALSO
-
-L<RT::Action::NotifyGroup>, L<RT::Action::NotifyGroupAsComment>
-
-=cut
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-no warnings 'once';
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-BEGIN {
- use RT;
- RT::LoadConfig();
- RT::Init();
-};
-use RT::Interface::CLI ();
-
-my %OPT = (
- help => 0,
- debug => 0,
- quiet => 0,
-);
-my @OPT_LIST = qw(help|h! debug! quiet);
-
-my $db_type = RT->Config->Get('DatabaseType');
-if ( $db_type eq 'Pg' ) {
- %OPT = (
- %OPT,
- limit => 0,
- all => 0,
- );
- push @OPT_LIST, 'limit=i', 'all!';
-}
-elsif ( $db_type eq 'mysql' ) {
- %OPT = (
- %OPT,
- limit => 0,
- all => 0,
- xmlpipe2 => 0,
- );
- push @OPT_LIST, 'limit=i', 'all!', 'xmlpipe2!';
-}
-elsif ( $db_type eq 'Oracle' ) {
- %OPT = (
- %OPT,
- memory => '2M',
- );
- push @OPT_LIST, qw(memory=s);
-}
-
-use Getopt::Long qw(GetOptions);
-GetOptions( \%OPT, @OPT_LIST );
-
-if ( $OPT{'help'} ) {
- RT::Interface::CLI->ShowHelp(
- Sections => 'NAME|DESCRIPTION|'. uc($db_type),
- );
-}
-
-use Fcntl ':flock';
-if ( !flock main::DATA, LOCK_EX | LOCK_NB ) {
- if ( $OPT{quiet} ) {
- RT::Logger->info("$0 is already running; aborting silently, as requested");
- exit;
- }
- else {
- print STDERR "$0 is already running\n";
- exit 1;
- }
-}
-
-my $fts_config = RT->Config->Get('FullTextSearch') || {};
-unless ( $fts_config->{'Enable'} ) {
- print STDERR <<EOT;
-
-Full text search is disabled in your RT configuration. Run
-/opt/rt3/sbin/rt-setup-fulltext-index to configure and enable it.
-
-EOT
- exit 1;
-}
-unless ( $fts_config->{'Indexed'} ) {
- print STDERR <<EOT;
-
-Full text search is enabled in your RT configuration, but not with any
-full-text database indexing -- hence this tool is not required. Read
-the documentation for %FullTextSearch in your RT_Config for more details.
-
-EOT
- exit 1;
-}
-
-if ( $db_type eq 'Oracle' ) {
- my $index = $fts_config->{'IndexName'} || 'rt_fts_index';
- $RT::Handle->dbh->do(
- "begin ctx_ddl.sync_index(?, ?); end;", undef,
- $index, $OPT{'memory'}
- );
- exit;
-} elsif ( $db_type eq 'mysql' ) {
- unless ($OPT{'xmlpipe2'}) {
- print STDERR <<EOT;
-
-Updates to the external Sphinx index are done via running the sphinx
-`indexer` tool:
-
- indexer rt
-
-EOT
- exit 1;
- }
-}
-
-my @types = qw(text html);
-foreach my $type ( @types ) {
- REDO:
- my $attachments = attachments($type);
- $attachments->Limit(
- FIELD => 'id',
- OPERATOR => '>',
- VALUE => last_indexed($type)
- );
- $attachments->OrderBy( FIELD => 'id', ORDER => 'asc' );
- $attachments->RowsPerPage( $OPT{'limit'} || 100 );
-
- my $found = 0;
- while ( my $a = $attachments->Next ) {
- next if filter( $type, $a );
- debug("Found attachment #". $a->id );
- my $txt = extract($type, $a) or next;
- $found++;
- process( $type, $a, $txt );
- debug("Processed attachment #". $a->id );
- }
- finalize( $type, $attachments ) if $found;
- clean( $type );
- goto REDO if $OPT{'all'} and $attachments->Count == ($OPT{'limit'} || 100)
-}
-
-sub attachments {
- my $type = shift;
- my $res = RT::Attachments->new( RT->SystemUser );
- my $txn_alias = $res->Join(
- ALIAS1 => 'main',
- FIELD1 => 'TransactionId',
- TABLE2 => 'Transactions',
- FIELD2 => 'id',
- );
- $res->Limit(
- ALIAS => $txn_alias,
- FIELD => 'ObjectType',
- VALUE => 'RT::Ticket',
- );
- my $ticket_alias = $res->Join(
- ALIAS1 => $txn_alias,
- FIELD1 => 'ObjectId',
- TABLE2 => 'Tickets',
- FIELD2 => 'id',
- );
- $res->Limit(
- ALIAS => $ticket_alias,
- FIELD => 'Status',
- OPERATOR => '!=',
- VALUE => 'deleted'
- );
-
- # On newer DBIx::SearchBuilder's, indicate that making the query DISTINCT
- # is unnecessary because the joins won't produce duplicates. This
- # drastically improves performance when fetching attachments.
- $res->{joins_are_distinct} = 1;
-
- return goto_specific(
- suffix => $type,
- error => "Don't know how to find $type attachments",
- arguments => [$res],
- );
-}
-
-sub last_indexed {
- my ($type) = (@_);
- return goto_specific(
- suffix => $db_type,
- error => "Don't know how to find last indexed $type attachment for $db_type DB",
- arguments => \@_,
- );
-}
-
-sub filter {
- my $type = shift;
- return goto_specific(
- suffix => $type,
- arguments => \@_,
- );
-}
-
-sub extract {
- my $type = shift;
- return goto_specific(
- suffix => $type,
- error => "No way to convert $type attachment into text",
- arguments => \@_,
- );
-}
-
-sub process {
- return goto_specific(
- suffix => $db_type,
- error => "No processer for $db_type DB",
- arguments => \@_,
- );
-}
-
-sub finalize {
- return goto_specific(
- suffix => $db_type,
- arguments => \@_,
- );
-}
-
-sub clean {
- return goto_specific(
- suffix => $db_type,
- arguments => \@_,
- );
-}
-
-{
-sub last_indexed_mysql {
- my $type = shift;
- my $attr = $RT::System->FirstAttribute('LastIndexedAttachments');
- return 0 unless $attr;
- return 0 unless exists $attr->{ $type };
- return $attr->{ $type } || 0;
-}
-
-sub process_mysql {
- my ($type, $attachment, $text) = (@_);
-
- my $doc = sphinx_template();
-
- my $element = $doc->createElement('sphinx:document');
- $element->setAttribute( id => $attachment->id );
- $element->appendTextChild( content => $$text );
-
- $doc->documentElement->appendChild( $element );
-}
-
-my $doc = undef;
-sub sphinx_template {
- return $doc if $doc;
-
- require XML::LibXML;
- $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
- my $root = $doc->createElement('sphinx:docset');
- $doc->setDocumentElement( $root );
-
- my $schema = $doc->createElement('sphinx:schema');
- $root->appendChild( $schema );
- foreach ( qw(content) ) {
- my $field = $doc->createElement('sphinx:field');
- $field->setAttribute( name => $_ );
- $schema->appendChild( $field );
- }
-
- return $doc;
-}
-
-sub finalize_mysql {
- my ($type, $attachments) = @_;
- sphinx_template()->toFH(*STDOUT, 1);
-}
-
-sub clean_mysql {
- $doc = undef;
-}
-
-}
-
-sub last_indexed_pg {
- my $type = shift;
- my $attachments = attachments( $type );
- my $alias = 'main';
- if ( $fts_config->{'Table'} && $fts_config->{'Table'} ne 'Attachments' ) {
- $alias = $attachments->Join(
- TYPE => 'left',
- FIELD1 => 'id',
- TABLE2 => $fts_config->{'Table'},
- FIELD2 => 'id',
- );
- }
- $attachments->Limit(
- ALIAS => $alias,
- FIELD => $fts_config->{'Column'},
- OPERATOR => 'IS NOT',
- VALUE => 'NULL',
- );
- $attachments->OrderBy( FIELD => 'id', ORDER => 'desc' );
- $attachments->RowsPerPage( 1 );
- my $res = $attachments->First;
- return 0 unless $res;
- return $res->id;
-}
-
-sub process_pg {
- my ($type, $attachment, $text) = (@_);
-
- my $dbh = $RT::Handle->dbh;
- my $table = $fts_config->{'Table'};
- my $column = $fts_config->{'Column'};
-
- my $query;
- if ( $table ) {
- if ( my ($id) = $dbh->selectrow_array("SELECT id FROM $table WHERE id = ?", undef, $attachment->id) ) {
- $query = "UPDATE $table SET $column = to_tsvector(?) WHERE id = ?";
- } else {
- $query = "INSERT INTO $table($column, id) VALUES(to_tsvector(?), ?)";
- }
- } else {
- $query = "UPDATE Attachments SET $column = to_tsvector(?) WHERE id = ?";
- }
-
- my $status = eval { $dbh->do( $query, undef, $$text, $attachment->id ) };
- unless ( $status ) {
- if ( $dbh->err == 7 && $dbh->state eq '54000' ) {
- warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains too many unique words. Error: ". $dbh->errstr;
- } elsif ( $dbh->err == 7 && $dbh->state eq '22021' ) {
- warn "Attachment @{[$attachment->id]} cannot be indexed. Most probably it contains invalid UTF8 bytes. Error: ". $dbh->errstr;
- } else {
- die "error: ". $dbh->errstr;
- }
-
- # Insert an empty tsvector, so we count this row as "indexed"
- # for purposes of knowing where to pick up
- eval { $dbh->do( $query, undef, "", $attachment->id ) }
- or die "Failed to insert empty tsvector: " . $dbh->errstr;
- }
-}
-
-sub attachments_text {
- my $res = shift;
- $res->Limit( FIELD => 'ContentType', VALUE => 'text/plain' );
- return $res;
-}
-
-sub extract_text {
- my $attachment = shift;
- my $text = $attachment->Content;
- return undef unless defined $text && length($text);
- return \$text;
-}
-
-sub attachments_html {
- my $res = shift;
- $res->Limit( FIELD => 'ContentType', VALUE => 'text/html' );
- return $res;
-}
-
-sub filter_html {
- my $attachment = shift;
- if ( my $parent = $attachment->ParentObj ) {
-# skip html parts that are alternatives
- return 1 if $parent->id
- && $parent->ContentType eq 'mulitpart/alternative';
- }
- return 0;
-}
-
-sub extract_html {
- my $attachment = shift;
- my $text = $attachment->Content;
- return undef unless defined $text && length($text);
-# TODO: html -> text
- return \$text;
-}
-
-sub goto_specific {
- my %args = (@_);
-
- my $func = (caller(1))[3];
- $func =~ s/.*:://;
- my $call = $func ."_". lc $args{'suffix'};
- unless ( defined &$call ) {
- return undef unless $args{'error'};
- require Carp; Carp::croak( $args{'error'} );
- }
- @_ = @{ $args{'arguments'} };
- goto &$call;
-}
-
-
-# helper functions
-sub debug { print @_, "\n" if $OPT{debug}; 1 }
-sub error { $RT::Logger->error(_(@_)); 1 }
-sub warning { $RT::Logger->warn(_(@_)); 1 }
-
-=head1 NAME
-
-rt-fulltext-indexer - Indexer for full text search
-
-=head1 DESCRIPTION
-
-This is a helper script to keep full text indexes in sync with data.
-Read F<docs/full_text_indexing.pod> for complete details on how and when
-to run it.
-
-=head1 AUTHOR
-
-Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>,
-Alex Vandiver E<lt>alexmv@bestpractical.comE<gt>
-
-=cut
-
-__DATA__
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', 'user|u=s', 'option|o=s' );
-
-if ( $opt{help} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
-
-require RT::Attributes;
-my $attrs = RT::Attributes->new( RT->SystemUser );
-$attrs->Limit( FIELD => 'Name', VALUE => 'Pref-RT::System-1' );
-$attrs->Limit( FIELD => 'ObjectType', VALUE => 'RT::User' );
-
-if ($opt{user}) {
- my $user = RT::User->new( RT->SystemUser );
- my ($val, $msg) = $user->Load($opt{user});
- unless ($val) {
- RT->Logger->error("Unable to load $opt{user}: $msg");
- exit(1);
- }
- $attrs->Limit( FIELD => 'ObjectId', VALUE => $user->Id );
-}
-
-use Data::Dumper;
-$Data::Dumper::Terse = 1;
-
-while (my $attr = $attrs->Next ) {
- my $user = RT::User->new( RT->SystemUser );
- my ($val, $msg) = $user->Load($attr->ObjectId);
- unless ($val) {
- RT->Logger->warn("Unable to load User ".$attr->ObjectId." $msg");
- next;
- }
- next if $user->Disabled;
-
- my $content = $attr->Content;
- if ( my $config_name = $opt{option} ) {
- if ( exists $content->{$config_name} ) {
- my $setting = $content->{$config_name};
- print $user->Name, "\t$config_name: $setting\n";
- }
- } else {
- print $user->Name, " => ", Dumper($content);
- }
-
-}
-
-__END__
-
-=head1 NAME
-
-rt-preferences-viewer - show user defined preferences
-
-=head1 SYNOPSIS
-
- rt-preferences-viewer
-
- rt-preferences-viewer --user=falcone
- show only the falcone user's preferences
-
- rt-preferences-viewer --option=EmailFrequency
- show users who have set the EmailFrequence config option
-
-=head1 DESCRIPTION
-
-This script shows user settings of preferences. If a user is using the system
-default, it will not be listed. You can limit to a user name or id or to users
-with a particular option set.
+++ /dev/null
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- die <<EOT if ${^TAINT};
-RT does not run under Perl's "taint mode". Remove -T from the command
-line, or remove the PerlTaintCheck parameter from your mod_perl
-configuration.
-EOT
-
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-no warnings 'once';
-
-if (grep { m/help/ } @ARGV) {
- require Pod::Usage;
- print Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-require RT;
-RT->LoadConfig();
-RT->InitPluginPaths();
-RT->InitLogging();
-require Module::Refresh if RT->Config->Get('DevelMode');
-
-require RT::Handle;
-my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
-
-unless ( $integrity ) {
- print STDERR <<EOF;
-
-RT couldn't connect to the database where tickets are stored.
-If this is a new installation of RT, you should visit the URL below
-to configure RT and initialize your database.
-
-If this is an existing RT installation, this may indicate a database
-connectivity problem.
-
-The error RT got back when trying to connect to your database was:
-
-$msg
-
-EOF
-
- require RT::Installer;
- # don't enter install mode if the file exists but is unwritable
- if (-e RT::Installer->ConfigFile && !-w _) {
- die 'Since your configuration exists ('
- . RT::Installer->ConfigFile
- . ") but is not writable, I'm refusing to do anything.\n";
- }
-
- RT->Config->Set( 'LexiconLanguages' => '*' );
- RT::I18N->Init;
-
- RT->InstallMode(1);
-} else {
- RT->Init( Heavy => 1 );
-
- my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
- unless ( $status ) {
- print STDERR $msg, "\n\n";
- exit -1;
- }
-}
-
-# we must disconnect DB before fork
-if ($RT::Handle) {
- $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
- $RT::Handle->dbh(undef);
- undef $RT::Handle;
-}
-
-require RT::Interface::Web::Handler;
-my $app = RT::Interface::Web::Handler->PSGIApp;
-
-if ($ENV{RT_TESTING}) {
- my $screen_logger = $RT::Logger->remove('screen');
- require Log::Dispatch::Perl;
- $RT::Logger->add(
- Log::Dispatch::Perl->new(
- name => 'rttest',
- min_level => $screen_logger->min_level,
- action => {
- error => 'warn',
- critical => 'warn'
- }
- )
- );
- require Plack::Middleware::Test::StashWarnings;
- $app = Plack::Middleware::Test::StashWarnings->wrap($app);
-}
-
-# when used as a psgi file
-if (caller) {
- return $app;
-}
-
-
-# load appropriate server
-
-require Plack::Runner;
-
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
-
-# figure out the port
-my $port;
-
-# handle "rt-server 8888" for back-compat, but complain about it
-if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
- warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
- unshift @ARGV, '--port';
-}
-
-my @args = @ARGV;
-
-use List::MoreUtils 'last_index';
-my $last_index = last_index { $_ eq '--port' } @args;
-
-my $explicit_port;
-
-if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
- $explicit_port = $args[$last_index+1];
- $port = $explicit_port;
-
- # inform the rest of the system what port we manually chose
- my $old_app = $app;
- $app = sub {
- my $env = shift;
-
- $env->{'rt.explicit_port'} = $port;
-
- $old_app->($env, @_);
- };
-}
-else {
- # default to the configured WebPort and inform Plack::Runner
- $port = RT->Config->Get('WebPort') || '8080';
- push @args, '--port', $port;
-}
-
-push @args, '--server', 'Standalone' if RT->InstallMode;
-push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
-
-$r->parse_options(@args);
-
-delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
-
-unless ($r->{env} eq 'development') {
- push @{$r->{options}}, server_ready => sub {
- my($args) = @_;
- my $name = $args->{server_software} || ref($args); # $args is $server
- my $host = $args->{host} || 0;
- my $proto = $args->{proto} || 'http';
- print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
- };
-}
-eval { $r->run($app) };
-if (my $err = $@) {
- handle_startup_error($err);
-}
-
-exit 0;
-
-sub handle_startup_error {
- my $err = shift;
- if ( $err =~ /listen/ ) {
- handle_bind_error();
- } else {
- die
- "Something went wrong while trying to run RT's standalone web server:\n\t"
- . $err;
- }
-}
-
-
-sub handle_bind_error {
-
- print STDERR <<EOF;
-WARNING: RT couldn't start up a web server on port @{[$port]}.
-This is often the case if the port is already in use or you're running @{[$0]}
-as someone other than your system's "root" user. You may also specify a
-temporary port with: $0 --port <port>
-EOF
-
- if ($explicit_port) {
- print STDERR
- "Please check your system configuration or choose another port\n\n";
- }
-}
-
-__END__
-
-=head1 NAME
-
-rt-server - RT standalone server
-
-=head1 SYNOPSIS
-
- # runs prefork server listening on port 8080, requires Starlet
- rt-server --port 8080
-
- # runs server listening on port 8080
- rt-server --server Standalone --port 8080
- # or
- standalone_httpd --port 8080
-
- # runs other PSGI server on port 8080
- rt-server --server Starman --port 8080
+++ /dev/null
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- die <<EOT if ${^TAINT};
-RT does not run under Perl's "taint mode". Remove -T from the command
-line, or remove the PerlTaintCheck parameter from your mod_perl
-configuration.
-EOT
-
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-no warnings 'once';
-
-if (grep { m/help/ } @ARGV) {
- require Pod::Usage;
- print Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-require RT;
-RT->LoadConfig();
-RT->InitPluginPaths();
-RT->InitLogging();
-require Module::Refresh if RT->Config->Get('DevelMode');
-
-require RT::Handle;
-my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
-
-unless ( $integrity ) {
- print STDERR <<EOF;
-
-RT couldn't connect to the database where tickets are stored.
-If this is a new installation of RT, you should visit the URL below
-to configure RT and initialize your database.
-
-If this is an existing RT installation, this may indicate a database
-connectivity problem.
-
-The error RT got back when trying to connect to your database was:
-
-$msg
-
-EOF
-
- require RT::Installer;
- # don't enter install mode if the file exists but is unwritable
- if (-e RT::Installer->ConfigFile && !-w _) {
- die 'Since your configuration exists ('
- . RT::Installer->ConfigFile
- . ") but is not writable, I'm refusing to do anything.\n";
- }
-
- RT->Config->Set( 'LexiconLanguages' => '*' );
- RT::I18N->Init;
-
- RT->InstallMode(1);
-} else {
- RT->Init( Heavy => 1 );
-
- my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
- unless ( $status ) {
- print STDERR $msg, "\n\n";
- exit -1;
- }
-}
-
-# we must disconnect DB before fork
-if ($RT::Handle) {
- $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
- $RT::Handle->dbh(undef);
- undef $RT::Handle;
-}
-
-require RT::Interface::Web::Handler;
-my $app = RT::Interface::Web::Handler->PSGIApp;
-
-if ($ENV{RT_TESTING}) {
- my $screen_logger = $RT::Logger->remove('screen');
- require Log::Dispatch::Perl;
- $RT::Logger->add(
- Log::Dispatch::Perl->new(
- name => 'rttest',
- min_level => $screen_logger->min_level,
- action => {
- error => 'warn',
- critical => 'warn'
- }
- )
- );
- require Plack::Middleware::Test::StashWarnings;
- $app = Plack::Middleware::Test::StashWarnings->wrap($app);
-}
-
-# when used as a psgi file
-if (caller) {
- return $app;
-}
-
-
-# load appropriate server
-
-require Plack::Runner;
-
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
-
-# figure out the port
-my $port;
-
-# handle "rt-server 8888" for back-compat, but complain about it
-if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
- warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
- unshift @ARGV, '--port';
-}
-
-my @args = @ARGV;
-
-use List::MoreUtils 'last_index';
-my $last_index = last_index { $_ eq '--port' } @args;
-
-my $explicit_port;
-
-if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
- $explicit_port = $args[$last_index+1];
- $port = $explicit_port;
-
- # inform the rest of the system what port we manually chose
- my $old_app = $app;
- $app = sub {
- my $env = shift;
-
- $env->{'rt.explicit_port'} = $port;
-
- $old_app->($env, @_);
- };
-}
-else {
- # default to the configured WebPort and inform Plack::Runner
- $port = RT->Config->Get('WebPort') || '8080';
- push @args, '--port', $port;
-}
-
-push @args, '--server', 'Standalone' if RT->InstallMode;
-push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
-
-$r->parse_options(@args);
-
-delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
-
-unless ($r->{env} eq 'development') {
- push @{$r->{options}}, server_ready => sub {
- my($args) = @_;
- my $name = $args->{server_software} || ref($args); # $args is $server
- my $host = $args->{host} || 0;
- my $proto = $args->{proto} || 'http';
- print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
- };
-}
-eval { $r->run($app) };
-if (my $err = $@) {
- handle_startup_error($err);
-}
-
-exit 0;
-
-sub handle_startup_error {
- my $err = shift;
- if ( $err =~ /listen/ ) {
- handle_bind_error();
- } else {
- die
- "Something went wrong while trying to run RT's standalone web server:\n\t"
- . $err;
- }
-}
-
-
-sub handle_bind_error {
-
- print STDERR <<EOF;
-WARNING: RT couldn't start up a web server on port @{[$port]}.
-This is often the case if the port is already in use or you're running @{[$0]}
-as someone other than your system's "root" user. You may also specify a
-temporary port with: $0 --port <port>
-EOF
-
- if ($explicit_port) {
- print STDERR
- "Please check your system configuration or choose another port\n\n";
- }
-}
-
-__END__
-
-=head1 NAME
-
-rt-server - RT standalone server
-
-=head1 SYNOPSIS
-
- # runs prefork server listening on port 8080, requires Starlet
- rt-server --port 8080
-
- # runs server listening on port 8080
- rt-server --server Standalone --port 8080
- # or
- standalone_httpd --port 8080
-
- # runs other PSGI server on port 8080
- rt-server --server Starman --port 8080
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <jesse@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', );
-
-my $session_id = shift;
-
-if ( $opt{help} || !$session_id ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
-
-require RT::Interface::Web::Session;
-my %session;
-
-tie %session, 'RT::Interface::Web::Session', $session_id;
-unless ( $session{'_session_id'} eq $session_id ) {
- print STDERR "Couldn't load session $session_id\n";
- exit 1;
-}
-
-use Data::Dumper;
-print "Content of session $session_id: ". Dumper( \%session);
-
-__END__
-
-=head1 NAME
-
-rt-session-viewer - show the content of a user's session
-
-=head1 SYNOPSIS
-
- # show the content of a session
- rt-session-viewer 2c21c8a2909c14eff12975dd2cc7b9a3
-
-=head1 DESCRIPTION
-
-This script deserializes and print content of a session identified
-by <session id>. May be useful for developers and for troubleshooting
-problems.
-
-=cut
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-use vars qw($Nobody $SystemUser $item);
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Term::ReadKey;
-use Getopt::Long;
-
-$| = 1; # unbuffer all output.
-
-my %args = (
- dba => 'freeside',
- package => 'RT',
-);
-GetOptions(
- \%args,
- 'action=s',
- 'force', 'debug',
- 'dba=s', 'dba-password=s', 'prompt-for-dba-password', 'package=s',
- 'datafile=s', 'datadir=s', 'skip-create', 'root-password-file=s',
- 'upgrade-from=s', 'upgrade-to=s',
- 'help|h',
-);
-
-no warnings 'once';
-if ( $args{help} || ! $args{'action'} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage({ verbose => 2 });
- exit;
-}
-
-require RT;
-RT->LoadConfig();
-RT->InitClasses();
-
-# Force warnings to be output to STDERR if we're not already logging
-# them at a higher level
-RT->Config->Set( LogToScreen => 'warning')
- unless ( RT->Config->Get( 'LogToScreen' )
- && RT->Config->Get( 'LogToScreen' ) =~ /^(debug|info|notice)$/ );
-
-# get customized root password
-my $root_password;
-if ( $args{'root-password-file'} ) {
- open( my $fh, '<', $args{'root-password-file'} )
- or die "Couldn't open 'args{'root-password-file'}' for reading: $!";
- $root_password = <$fh>;
- chomp $root_password;
- my $min_length = RT->Config->Get('MinimumPasswordLength');
- if ($min_length) {
- die
-"password needs to be at least $min_length long, please check file '$args{'root-password-file'}'"
- if length $root_password < $min_length;
- }
- close $fh;
-}
-
-
-# check and setup @actions
-my @actions = grep $_, split /,/, $args{'action'};
-if ( @actions > 1 && $args{'datafile'} ) {
- print STDERR "You can not use --datafile option with multiple actions.\n";
- exit(-1);
-}
-foreach ( @actions ) {
- unless ( /^(?:init|create|drop|schema|acl|coredata|insert|upgrade)$/ ) {
- print STDERR "$0 called with an invalid --action parameter.\n";
- exit(-1);
- }
- if ( /^(?:init|drop|upgrade)$/ && @actions > 1 ) {
- print STDERR "You can not mix init, drop or upgrade action with any action.\n";
- exit(-1);
- }
-}
-
-# convert init to multiple actions
-my $init = 0;
-if ( $actions[0] eq 'init' ) {
- if ($args{'skip-create'}) {
- @actions = qw(schema coredata insert);
- } else {
- @actions = qw(create schema acl coredata insert);
- }
- $init = 1;
-}
-
-# set options from environment
-foreach my $key(qw(Type Host Name User Password)) {
- next unless exists $ENV{ 'RT_DB_'. uc $key };
- print "Using Database$key from RT_DB_". uc($key) ." environment variable.\n";
- RT->Config->Set( "Database$key", $ENV{ 'RT_DB_'. uc $key });
-}
-
-my $db_type = RT->Config->Get('DatabaseType') || '';
-my $db_host = RT->Config->Get('DatabaseHost') || '';
-my $db_port = RT->Config->Get('DatabasePort') || '';
-my $db_name = RT->Config->Get('DatabaseName') || '';
-my $db_user = RT->Config->Get('DatabaseUser') || '';
-my $db_pass = RT->Config->Get('DatabasePassword') || '';
-
-# load it here to get error immidiatly if DB type is not supported
-require RT::Handle;
-
-if ( $db_type eq 'SQLite' && !File::Spec->file_name_is_absolute($db_name) ) {
- $db_name = File::Spec->catfile($RT::VarPath, $db_name);
- RT->Config->Set( DatabaseName => $db_name );
-}
-
-my $dba_user = $args{'dba'} || $ENV{'RT_DBA_USER'} || $db_user || '';
-my $dba_pass = exists($args{'dba-password'})
- ? $args{'dba-password'}
- : $ENV{'RT_DBA_PASSWORD'};
-
-if ($args{'skip-create'}) {
- $dba_user = $db_user;
- $dba_pass = $db_pass;
-} else {
- if ( !$args{force} && ( !defined $dba_pass || $args{'prompt-for-dba-password'} ) ) {
- $dba_pass = get_dba_password();
- chomp $dba_pass if defined($dba_pass);
- }
-}
-
-my $version_word_regex = join '|', RT::Handle->version_words;
-my $version_dir = qr/^\d+\.\d+\.\d+(?:$version_word_regex)?\d*$/;
-
-print "Working with:\n"
- ."Type:\t$db_type\nHost:\t$db_host\nPort:\t$db_port\nName:\t$db_name\n"
- ."User:\t$db_user\nDBA:\t$dba_user" . ($args{'skip-create'} ? ' (No DBA)' : '') . "\n";
-
-foreach my $action ( @actions ) {
- no strict 'refs';
- my ($status, $msg) = *{ 'action_'. $action }{'CODE'}->( %args );
- error($action, $msg) unless $status;
- print $msg .".\n" if $msg;
- print "Done.\n";
-}
-
-sub action_create {
- my %args = @_;
- my $dbh = get_system_dbh();
- my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'create' );
- return ($status, $msg) unless $status;
-
- print "Now creating a $db_type database $db_name for RT.\n";
- return RT::Handle->CreateDatabase( $dbh );
-}
-
-sub action_drop {
- my %args = @_;
-
- print "Dropping $db_type database $db_name.\n";
- unless ( $args{'force'} ) {
- print <<END;
-
-About to drop $db_type database $db_name on $db_host (port '$db_port').
-WARNING: This will erase all data in $db_name.
-
-END
- exit(-2) unless _yesno();
- }
-
- my $dbh = get_system_dbh();
- return RT::Handle->DropDatabase( $dbh );
-}
-
-sub action_schema {
- my %args = @_;
- my $dbh = get_admin_dbh();
- my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'schema' );
- return ($status, $msg) unless $status;
-
- print "Now populating database schema.\n";
- return RT::Handle->InsertSchema( $dbh, $args{'datafile'} || $args{'datadir'} );
-}
-
-sub action_acl {
- my %args = @_;
- my $dbh = get_admin_dbh();
- my ($status, $msg) = RT::Handle->CheckCompatibility( $dbh, 'acl' );
- return ($status, $msg) unless $status;
-
- print "Now inserting database ACLs.\n";
- return RT::Handle->InsertACL( $dbh, $args{'datafile'} || $args{'datadir'} );
-}
-
-sub action_coredata {
- my %args = @_;
- $RT::Handle = RT::Handle->new;
- $RT::Handle->dbh( undef );
- RT::ConnectToDatabase();
- RT::InitLogging();
- my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'coredata' );
- return ($status, $msg) unless $status;
-
- print "Now inserting RT core system objects.\n";
- return $RT::Handle->InsertInitialData;
-}
-
-sub action_insert {
- my %args = @_;
- $RT::Handle = RT::Handle->new;
- RT::Init();
- my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'insert' );
- return ($status, $msg) unless $status;
-
- print "Now inserting data.\n";
- my $file = $args{'datafile'};
- $file = $RT::EtcPath . "/initialdata" if $init && !$file;
- $file ||= $args{'datadir'}."/content";
-
- # Slurp in backcompat
- my %removed;
- my @back = @{$args{backcompat} || []};
- if (@back) {
- my @lines = do {local @ARGV = @back; <>};
- for (@lines) {
- s/\#.*//;
- next unless /\S/;
- my ($class, @fields) = split;
- $class->_BuildTableAttributes;
- $RT::Logger->debug("Temporarily removing @fields from $class");
- $removed{$class}{$_} = delete $RT::Record::_TABLE_ATTR->{$class}{$_}
- for @fields;
- }
- }
-
- my @ret = $RT::Handle->InsertData( $file, $root_password );
-
- # Put back the fields we chopped off
- for my $class (keys %removed) {
- $RT::Record::_TABLE_ATTR->{$class}{$_} = $removed{$class}{$_}
- for keys %{$removed{$class}};
- }
- return @ret;
-}
-
-sub action_upgrade {
- my %args = @_;
- my $base_dir = $args{'datadir'} || "./etc/upgrade";
- return (0, "Couldn't read dir '$base_dir' with upgrade data")
- unless -d $base_dir || -r _;
-
- my $upgrading_from = undef;
- do {
- if ( defined $upgrading_from ) {
- print "Doesn't match #.#.#: ";
- } else {
- print "Enter $args{package} version you're upgrading from: ";
- }
- $upgrading_from = $args{'upgrade-from'} || scalar <STDIN>;
- chomp $upgrading_from;
- $upgrading_from =~ s/\s+//g;
- } while $upgrading_from !~ /$version_dir/;
-
- my $upgrading_to = $RT::VERSION;
- return (0, "The current version $upgrading_to is lower than $upgrading_from")
- if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) > 0;
-
- return (1, "The version $upgrading_to you're upgrading to is up to date")
- if RT::Handle::cmp_version( $upgrading_from, $upgrading_to ) == 0;
-
- my @versions = get_versions_from_to($base_dir, $upgrading_from, undef);
- return (1, "No DB changes since $upgrading_from")
- unless @versions;
-
- if (RT::Handle::cmp_version($versions[-1], $upgrading_to) > 0) {
- print "\n***** There are upgrades for $versions[-1], which is later than $upgrading_to,\n";
- print "***** which you are nominally upgrading to. Upgrading to $versions[-1] instead.\n";
- $upgrading_to = $versions[-1];
- }
-
- print "\nGoing to apply following upgrades:\n";
- print map "* $_\n", @versions;
-
- {
- my $custom_upgrading_to = undef;
- do {
- if ( defined $custom_upgrading_to ) {
- print "Doesn't match #.#.#: ";
- } else {
- print "\nEnter $args{package} version if you want to stop upgrade at some point,\n";
- print " or leave it blank if you want apply above upgrades: ";
- }
- $custom_upgrading_to = $args{'upgrade-to'} || scalar <STDIN>;
- chomp $custom_upgrading_to;
- $custom_upgrading_to =~ s/\s+//g;
- last unless $custom_upgrading_to;
- } while $custom_upgrading_to !~ /$version_dir/;
-
- if ( $custom_upgrading_to ) {
- return (
- 0, "The version you entered ($custom_upgrading_to) is lower than\n"
- ."version you're upgrading from ($upgrading_from)"
- ) if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) > 0;
-
- return (1, "The version you're upgrading to is up to date")
- if RT::Handle::cmp_version( $upgrading_from, $custom_upgrading_to ) == 0;
-
- if ( RT::Handle::cmp_version( $RT::VERSION, $custom_upgrading_to ) < 0 ) {
- print "Version you entered is greater than installed ($RT::VERSION).\n";
- _yesno() or exit(-2);
- }
- # ok, checked everything no let's refresh list
- $upgrading_to = $custom_upgrading_to;
- @versions = get_versions_from_to($base_dir, $upgrading_from, $upgrading_to);
-
- return (1, "No DB changes between $upgrading_from and $upgrading_to")
- unless @versions;
-
- print "\nGoing to apply following upgrades:\n";
- print map "* $_\n", @versions;
- }
- }
-
- print "\nIT'S VERY IMPORTANT TO BACK UP BEFORE THIS STEP\n\n";
- _yesno() or exit(-2) unless $args{'force'};
-
- my ( $ret, $msg );
- foreach my $n ( 0..$#versions ) {
- my $v = $versions[$n];
- my @back = grep {-e $_} map {"$base_dir/$versions[$_]/backcompat"} $n+1..$#versions;
- print "Processing $v\n";
- my %tmp = (%args, datadir => "$base_dir/$v", datafile => undef, backcompat => \@back);
- if ( -e "$base_dir/$v/schema.$db_type" ) {
- ( $ret, $msg ) = action_schema( %tmp );
- return ( $ret, $msg ) unless $ret;
- }
- if ( -e "$base_dir/$v/acl.$db_type" ) {
- ( $ret, $msg ) = action_acl( %tmp );
- return ( $ret, $msg ) unless $ret;
- }
- if ( -e "$base_dir/$v/content" ) {
- ( $ret, $msg ) = action_insert( %tmp );
- return ( $ret, $msg ) unless $ret;
- }
- }
- return 1;
-}
-
-sub get_versions_from_to {
- my ($base_dir, $from, $to) = @_;
-
- opendir( my $dh, $base_dir ) or die "couldn't open dir: $!";
- my @versions = grep -d "$base_dir/$_" && /$version_dir/, readdir $dh;
- closedir $dh;
-
- die "\nERROR: No upgrade data found in '$base_dir'! Perhaps you specified the wrong --datadir?\n"
- unless @versions;
-
- return
- grep defined $to ? RT::Handle::cmp_version($_, $to) <= 0 : 1,
- grep RT::Handle::cmp_version($_, $from) > 0,
- sort RT::Handle::cmp_version @versions;
-}
-
-sub error {
- my ($action, $msg) = @_;
- print STDERR "Couldn't finish '$action' step.\n\n";
- print STDERR "ERROR: $msg\n\n";
- exit(-1);
-}
-
-sub get_dba_password {
- print "In order to create or update your RT database,"
- . " this script needs to connect to your "
- . " $db_type instance on $db_host (port '$db_port') as $dba_user\n";
- print "Please specify that user's database password below. If the user has no database\n";
- print "password, just press return.\n\n";
- print "Password: ";
- ReadMode('noecho');
- my $password = ReadLine(0);
- ReadMode('normal');
- print "\n";
- return ($password);
-}
-
-# get_system_dbh
-# Returns L<DBI> database handle connected to B<system> with DBA credentials.
-# See also L<RT::Handle/SystemDSN>.
-
-
-sub get_system_dbh {
- return _get_dbh( RT::Handle->SystemDSN, $dba_user, $dba_pass );
-}
-
-sub get_admin_dbh {
- return _get_dbh( RT::Handle->DSN, $dba_user, $dba_pass );
-}
-
-# get_rt_dbh [USER, PASSWORD]
-
-# Returns L<DBI> database handle connected to RT database,
-# you may specify credentials(USER and PASSWORD) to connect
-# with. By default connects with credentials from RT config.
-
-sub get_rt_dbh {
- return _get_dbh( RT::Handle->DSN, $db_user, $db_pass );
-}
-
-sub _get_dbh {
- my ($dsn, $user, $pass) = @_;
- my $dbh = DBI->connect(
- $dsn, $user, $pass,
- { RaiseError => 0, PrintError => 0 },
- );
- unless ( $dbh ) {
- my $msg = "Failed to connect to $dsn as user '$user': ". $DBI::errstr;
- if ( $args{'debug'} ) {
- require Carp; Carp::confess( $msg );
- } else {
- print STDERR $msg; exit -1;
- }
- }
- return $dbh;
-}
-
-sub _yesno {
- print "Proceed [y/N]:";
- my $x = scalar(<STDIN>);
- $x =~ /^y/i;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-rt-setup-database - Set up RT's database
-
-=head1 SYNOPSIS
-
- rt-setup-database --action ...
-
-=head1 OPTIONS
-
-=over
-
-=item action
-
-Several actions can be combined using comma separated list.
-
-=over
-
-=item init
-
-Initialize the database. This is combination of multiple actions listed below.
-Create DB, schema, setup acl, insert core data and initial data.
-
-=item upgrade
-
-Apply all needed schema/acl/content updates (will ask for version to upgrade
-from)
-
-=item create
-
-Create the database.
-
-=item drop
-
-Drop the database. This will B<ERASE ALL YOUR DATA>.
-
-=item schema
-
-Initialize only the database schema
-
-To use a local or supplementary datafile, specify it using the '--datadir'
-option below.
-
-=item acl
-
-Initialize only the database ACLs
-
-To use a local or supplementary datafile, specify it using the '--datadir'
-option below.
-
-=item coredata
-
-Insert data into RT's database. This data is required for normal functioning of
-any RT instance.
-
-=item insert
-
-Insert data into RT's database. By default, will use RT's installation data.
-To use a local or supplementary datafile, specify it using the '--datafile'
-option below.
-
-=back
-
-=item datafile
-
-file path of the data you want to action on
-
-e.g. C<--datafile /path/to/datafile>
-
-=item datadir
-
-Used to specify a path to find the local database schema and acls to be
-installed.
-
-e.g. C<--datadir /path/to/>
-
-=item dba
-
-dba's username
-
-=item dba-password
-
-dba's password
-
-=item prompt-for-dba-password
-
-Ask for the database administrator's password interactively
-
-=item skip-create
-
-for 'init': skip creating the database and the user account, so we don't need
-administrator privileges
-
-=item root-password-file
-
-for 'init' and 'insert': rather than using the default administrative password
-for RT's "root" user, use the password in this file.
-
-=item upgrade-from
-
-for 'upgrade': specifies the version to upgrade from, and do not prompt
-for it if it appears to be a valid version.
-
-=item upgrade-to
-
-for 'upgrade': specifies the version to upgrade to, and do not prompt
-for it if it appears to be a valid version.
-
-=back
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-no warnings 'once';
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-BEGIN {
- use RT;
- RT::LoadConfig();
- RT::Init();
-};
-use RT::Interface::CLI ();
-
-my %DB = (
- type => scalar RT->Config->Get('DatabaseType'),
- user => scalar RT->Config->Get('DatabaseUser'),
- admin => 'freeside',
- admin_password => undef,
-);
-
-my %OPT = (
- help => 0,
- ask => 1,
- dryrun => 0,
- attachments => 1,
-);
-
-my %DEFAULT;
-if ( $DB{'type'} eq 'Pg' ) {
- %DEFAULT = (
- table => 'Attachments',
- column => 'ContentIndex',
- );
-}
-elsif ( $DB{'type'} eq 'mysql' ) {
- %DEFAULT = (
- table => 'AttachmentsIndex',
- );
-}
-elsif ( $DB{'type'} eq 'Oracle' ) {
- %DEFAULT = (
- prefix => 'rt_fts_',
- );
-}
-
-use Getopt::Long qw(GetOptions);
-GetOptions(
- 'h|help!' => \$OPT{'help'},
- 'ask!' => \$OPT{'ask'},
- 'dry-run!' => \$OPT{'dryrun'},
- 'attachments!' => \$OPT{'attachments'},
-
- 'table=s' => \$OPT{'table'},
- 'column=s' => \$OPT{'column'},
- 'url=s' => \$OPT{'url'},
- 'maxmatches=i' => \$OPT{'maxmatches'},
- 'index-type=s' => \$OPT{'index-type'},
-
- 'dba=s' => \$DB{'admin'},
- 'dba-password=s' => \$DB{'admin_password'},
-) or show_help();
-
-if ( $OPT{'help'} || (!$DB{'admin'} && $DB{'type'} eq 'Oracle' ) ) {
- show_help( !$OPT{'help'} );
-}
-
-my $dbh = $RT::Handle->dbh;
-$dbh->{'RaiseError'} = 1;
-$dbh->{'PrintError'} = 1;
-
-if ( $DB{'type'} eq 'mysql' ) {
- check_sphinx();
- my $table = $OPT{'table'} || prompt(
- message => "Enter name of a new MySQL table that will be used to connect to the\n"
- . "Sphinx server:",
- default => $DEFAULT{'table'},
- silent => !$OPT{'ask'},
- );
-
- my $url = 'sphinx://localhost:3312/rt';
- my $version = ($dbh->selectrow_array("show variables like 'version'"))[1];
- $url = 'sphinx://127.0.0.1:3312/rt'
- if $version and $version =~ /^(\d+\.\d+)/ and $1 >= 5.5;
-
- $url = $OPT{'url'} || prompt(
- message => "Enter URL of the sphinx search server; this should be of the form\n"
- . "sphinx://<server>:<port>/<index name>",
- default => $url,
- silent => !$OPT{'ask'},
- );
- my $maxmatches = $OPT{'maxmatches'} || prompt(
- message => "Maximum number of matches to return; this is the maximum number of\n"
- . "attachment records returned by the search, not the maximum number\n"
- . "of tickets. Both your RT_SiteConfig.pm and your sphinx.conf must\n"
- . "agree on this value. Larger values cause your Sphinx server to\n"
- . "consume more memory and CPU time per query.",
- default => 10000,
- silent => !$OPT{'ask'},
- );
-
- my $schema = <<END;
-CREATE TABLE $table (
- id INTEGER UNSIGNED NOT NULL,
- weight INTEGER NOT NULL,
- query VARCHAR(3072) NOT NULL,
- INDEX(query)
-) ENGINE=SPHINX CONNECTION="$url" CHARACTER SET utf8
-END
-
- do_error_is_ok( dba_handle() => "DROP TABLE $table" )
- unless $OPT{'dryrun'};
- insert_schema( $schema );
-
- print_rt_config( Table => $table, MaxMatches => $maxmatches );
-
- require URI;
- my $urlo = URI->new( $url );
- my ($host, $port) = split /:/, $urlo->authority;
- my $index = $urlo->path;
- $index =~ s{^/+}{};
-
- my $var_path = $RT::VarPath;
-
- my %sphinx_conf = ();
- $sphinx_conf{'host'} = RT->Config->Get('DatabaseHost');
- $sphinx_conf{'db'} = RT->Config->Get('DatabaseName');
- $sphinx_conf{'user'} = RT->Config->Get('DatabaseUser');
- $sphinx_conf{'pass'} = RT->Config->Get('DatabasePassword');
-
- print <<END
-
-Below is a simple Sphinx configuration which can be used to index all
-text/plain attachments in your database. This configuration is not
-ideal; you should read the Sphinx documentation to understand how to
-configure it to better suit your needs.
-
-source rt {
- type = mysql
-
- sql_host = $sphinx_conf{'host'}
- sql_db = $sphinx_conf{'db'}
- sql_user = $sphinx_conf{'user'}
- sql_pass = $sphinx_conf{'pass'}
-
- sql_query_pre = SET NAMES utf8
- sql_query = \\
- SELECT a.id, a.content FROM Attachments a \\
- JOIN Transactions txn ON a.TransactionId = txn.id AND txn.ObjectType = 'RT::Ticket' \\
- JOIN Tickets t ON txn.ObjectId = t.id \\
- WHERE a.ContentType = 'text/plain' AND t.Status != 'deleted'
-
- sql_query_info = SELECT * FROM Attachments WHERE id=\$id
-}
-
-index $index {
- source = rt
- path = $var_path/sphinx/index
- docinfo = extern
- charset_type = utf-8
-}
-
-indexer {
- mem_limit = 32M
-}
-
-searchd {
- port = $port
- log = $var_path/sphinx/searchd.log
- query_log = $var_path/sphinx/query.log
- read_timeout = 5
- max_children = 30
- pid_file = $var_path/sphinx/searchd.pid
- max_matches = $maxmatches
- seamless_rotate = 1
- preopen_indexes = 0
- unlink_old = 1
-}
-
-END
-
-}
-elsif ( $DB{'type'} eq 'Pg' ) {
- check_tsvalue();
- my $table = $OPT{'table'} || prompt(
- message => "Enter the name of a DB table that will be used to store the Pg tsvector.\n"
- . "You may either use the existing Attachments table, or create a new\n"
- . "table.",
- default => $DEFAULT{'table'},
- silent => !$OPT{'ask'},
- );
- my $column = $OPT{'column'} || prompt(
- message => 'Enter the name of a column that will be used to store the Pg tsvector:',
- default => $DEFAULT{'column'},
- silent => !$OPT{'ask'},
- );
-
- my $schema;
- my $drop;
- if ( lc($table) eq 'attachments' ) {
- $drop = "ALTER TABLE $table DROP COLUMN $column";
- $schema = "ALTER TABLE $table ADD COLUMN $column tsvector";
- } else {
- $drop = "DROP TABLE $table";
- $schema = "CREATE TABLE $table ( "
- ."id INTEGER NOT NULL,"
- ."$column tsvector )";
- }
-
- my $index_type = lc($OPT{'index-type'} || '');
- while ( $index_type ne 'gist' and $index_type ne 'gin' ) {
- $index_type = lc prompt(
- message => "You may choose between GiST or GIN indexes; the former is several times\n"
- . "slower to search, but takes less space on disk and is faster to update.",
- default => 'GiST',
- silent => !$OPT{'ask'},
- );
- }
-
- do_error_is_ok( dba_handle() => $drop )
- unless $OPT{'dryrun'};
- insert_schema( $schema );
- insert_schema("CREATE INDEX ${column}_idx ON $table USING $index_type($column)");
-
- print_rt_config( Table => $table, Column => $column );
-}
-elsif ( $DB{'type'} eq 'Oracle' ) {
- {
- my $dbah = dba_handle();
- do_print_error( $dbah => 'GRANT CTXAPP TO '. $DB{'user'} );
- do_print_error( $dbah => 'GRANT EXECUTE ON CTXSYS.CTX_DDL TO '. $DB{'user'} );
- }
-
- my %PREFERENCES = (
- datastore => {
- type => 'DIRECT_DATASTORE',
- },
- filter => {
- type => 'AUTO_FILTER',
-# attributes => {
-# timeout => 120, # seconds
-# timeout_type => 'HEURISTIC', # or 'FIXED'
-# },
- },
- lexer => {
- type => 'WORLD_LEXER',
- },
- word_list => {
- type => 'BASIC_WORDLIST',
- attributes => {
- stemmer => 'AUTO',
- fuzzy_match => 'AUTO',
-# fuzzy_score => undef,
-# fuzzy_numresults => undef,
-# substring_index => undef,
-# prefix_index => undef,
-# prefix_length_min => undef,
-# prefix_length_max => undef,
-# wlidcard_maxterms => undef,
- },
- },
- 'section_group' => {
- type => 'NULL_SECTION_GROUP',
- },
-
- storage => {
- type => 'BASIC_STORAGE',
- attributes => {
- R_TABLE_CLAUSE => 'lob (data) store as (cache)',
- I_INDEX_CLAUSE => 'compress 2',
- },
- },
- );
-
- my @params = ();
- push @params, ora_create_datastore( %{ $PREFERENCES{'datastore'} } );
- push @params, ora_create_filter( %{ $PREFERENCES{'filter'} } );
- push @params, ora_create_lexer( %{ $PREFERENCES{'lexer'} } );
- push @params, ora_create_word_list( %{ $PREFERENCES{'word_list'} } );
- push @params, ora_create_stop_list();
- push @params, ora_create_section_group( %{ $PREFERENCES{'section_group'} } );
- push @params, ora_create_storage( %{ $PREFERENCES{'storage'} } );
-
- my $index_params = join "\n", @params;
- my $index_name = $DEFAULT{prefix} .'index';
- do_error_is_ok( $dbh => "DROP INDEX $index_name" )
- unless $OPT{'dryrun'};
- $dbh->do(
- "CREATE INDEX $index_name ON Attachments(Content)
- indextype is ctxsys.context parameters('
- $index_params
- ')",
- ) unless $OPT{'dryrun'};
-
- print_rt_config( IndexName => $index_name );
-}
-else {
- die "Full-text indexes on $DB{type} are not yet supported";
-}
-
-sub check_tsvalue {
- my $dbh = $RT::Handle->dbh;
- my $fts = ($dbh->selectrow_array(<<EOQ))[0];
-SELECT 1 FROM information_schema.routines WHERE routine_name = 'plainto_tsquery'
-EOQ
- unless ($fts) {
- print STDERR <<EOT;
-
-Your PostgreSQL server does not include full-text support. You will
-need to upgrade to PostgreSQL version 8.3 or higher to use full-text
-indexing.
-
-EOT
- exit 1;
- }
-}
-
-sub check_sphinx {
- return if $RT::Handle->CheckSphinxSE;
-
- print STDERR <<EOT;
-
-Your MySQL server has not been compiled with the Sphinx storage engine
-(sphinxse). You will need to recompile MySQL according to the
-instructions in Sphinx's documentation at
-http://sphinxsearch.com/docs/current.html#sphinxse-installing
-
-EOT
- exit 1;
-}
-
-sub ora_create_datastore {
- return sprintf 'datastore %s', ora_create_preference(
- @_,
- name => 'datastore',
- );
-}
-
-sub ora_create_filter {
- my $res = '';
- $res .= sprintf "format column %s\n", ora_create_format_column();
- $res .= sprintf 'filter %s', ora_create_preference(
- @_,
- name => 'filter',
- );
- return $res;
-}
-
-sub ora_create_lexer {
- return sprintf 'lexer %s', ora_create_preference(
- @_,
- name => 'lexer',
- );
-}
-
-sub ora_create_word_list {
- return sprintf 'wordlist %s', ora_create_preference(
- @_,
- name => 'word_list',
- );
-}
-
-sub ora_create_stop_list {
- my $file = shift || 'etc/stopwords/en.txt';
- return '' unless -e $file;
-
- my $name = $DEFAULT{'prefix'} .'stop_list';
- unless ($OPT{'dryrun'}) {
- do_error_is_ok( $dbh => 'begin ctx_ddl.drop_stoplist(?); end;', $name );
-
- $dbh->do(
- 'begin ctx_ddl.create_stoplist(?, ?); end;',
- undef, $name, 'BASIC_STOPLIST'
- );
-
- open( my $fh, '<:utf8', $file )
- or die "couldn't open file '$file': $!";
- while ( my $word = <$fh> ) {
- chomp $word;
- $dbh->do(
- 'begin ctx_ddl.add_stopword(?, ?); end;',
- undef, $name, $word
- );
- }
- close $fh;
- }
- return sprintf 'stoplist %s', $name;
-}
-
-sub ora_create_section_group {
- my %args = @_;
- my $name = $DEFAULT{'prefix'} .'section_group';
- unless ($OPT{'dryrun'}) {
- do_error_is_ok( $dbh => 'begin ctx_ddl.drop_section_group(?); end;', $name );
- $dbh->do(
- 'begin ctx_ddl.create_section_group(?, ?); end;',
- undef, $name, $args{'type'}
- );
- }
- return sprintf 'section group %s', $name;
-}
-
-sub ora_create_storage {
- return sprintf 'storage %s', ora_create_preference(
- @_,
- name => 'storage',
- );
-}
-
-sub ora_create_format_column {
- my $column_name = 'ContentOracleFormat';
- return $column_name if $OPT{'dryrun'};
- unless (
- $dbh->column_info(
- undef, undef, uc('Attachments'), uc( $column_name )
- )->fetchrow_array
- ) {
- $dbh->do(qq{
- ALTER TABLE Attachments ADD $column_name VARCHAR2(10)
- });
- }
-
- my $detect_format = qq{
- CREATE OR REPLACE FUNCTION $DEFAULT{prefix}detect_format_simple(
- parent IN NUMBER,
- type IN VARCHAR2,
- encoding IN VARCHAR2,
- fname IN VARCHAR2
- )
- RETURN VARCHAR2
- AS
- format VARCHAR2(10);
- BEGIN
- format := CASE
- };
- unless ( $OPT{'attachments'} ) {
- $detect_format .= qq{
- WHEN fname IS NOT NULL THEN 'ignore'
- };
- }
- $detect_format .= qq{
- WHEN type = 'text' THEN 'text'
- WHEN type = 'text/rtf' THEN 'ignore'
- WHEN type LIKE 'text/%' THEN 'text'
- WHEN type LIKE 'message/%' THEN 'text'
- ELSE 'ignore'
- END;
- RETURN format;
- END;
- };
- ora_create_procedure( $detect_format );
-
- $dbh->do(qq{
- UPDATE Attachments
- SET $column_name = $DEFAULT{prefix}detect_format_simple(
- Parent,
- ContentType, ContentEncoding,
- Filename
- )
- WHERE $column_name IS NULL
- });
- $dbh->do(qq{
- CREATE OR REPLACE TRIGGER $DEFAULT{prefix}set_format
- BEFORE INSERT
- ON Attachments
- FOR EACH ROW
- BEGIN
- :new.$column_name := $DEFAULT{prefix}detect_format_simple(
- :new.Parent,
- :new.ContentType, :new.ContentEncoding,
- :new.Filename
- );
- END;
- });
- return $column_name;
-}
-
-sub ora_create_preference {
- my %info = @_;
- my $name = $DEFAULT{'prefix'} . $info{'name'};
- return $name if $OPT{'dryrun'};
- do_error_is_ok( $dbh => 'begin ctx_ddl.drop_preference(?); end;', $name );
- $dbh->do(
- 'begin ctx_ddl.create_preference(?, ?); end;',
- undef, $name, $info{'type'}
- );
- return $name unless $info{'attributes'};
-
- while ( my ($attr, $value) = each %{ $info{'attributes'} } ) {
- $dbh->do(
- 'begin ctx_ddl.set_attribute(?, ?, ?); end;',
- undef, $name, $attr, $value
- );
- }
-
- return $name;
-}
-
-sub ora_create_procedure {
- my $text = shift;
-
- return if $OPT{'dryrun'};
- my $status = $dbh->do($text, { RaiseError => 0 });
-
- # Statement succeeded
- return if $status;
-
- if ( 6550 != $dbh->err ) {
- # Utter failure
- die $dbh->errstr;
- }
- else {
- my $msg = $dbh->func( 'plsql_errstr' );
- die $dbh->errstr if !defined $msg;
- die $msg if $msg;
- }
-}
-
-sub dba_handle {
- if ( $DB{'type'} eq 'Oracle' ) {
- $ENV{'NLS_LANG'} = "AMERICAN_AMERICA.AL32UTF8";
- $ENV{'NLS_NCHAR'} = "AL32UTF8";
- }
- my $dsn = do { my $h = new RT::Handle; $h->BuildDSN; $h->DSN };
- my $dbh = DBI->connect(
- $dsn, $DB{admin}, $DB{admin_password},
- { RaiseError => 1, PrintError => 1 },
- );
- unless ( $dbh ) {
- die "Failed to connect to $dsn as user '$DB{admin}': ". $DBI::errstr;
- }
- return $dbh;
-}
-
-sub do_error_is_ok {
- my $dbh = shift;
- local $dbh->{'RaiseError'} = 0;
- local $dbh->{'PrintError'} = 0;
- return $dbh->do(shift, undef, @_);
-}
-
-sub do_print_error {
- my $dbh = shift;
- local $dbh->{'RaiseError'} = 0;
- local $dbh->{'PrintError'} = 1;
- return $dbh->do(shift, undef, @_);
-}
-
-sub prompt {
- my %args = ( @_ );
- return $args{'default'} if $args{'silent'};
-
- local $| = 1;
- print $args{'message'};
- if ( $args{'default'} ) {
- print "\n[". $args{'default'} .']: ';
- } else {
- print ":\n";
- }
-
- my $res = <STDIN>;
- chomp $res;
- print "\n";
- return $args{'default'} if !$res && $args{'default'};
- return $res;
-}
-
-sub verbose { print @_, "\n" if $OPT{verbose} || $OPT{verbose}; 1 }
-sub debug { print @_, "\n" if $OPT{debug}; 1 }
-sub error { $RT::Logger->error( @_ ); verbose(@_); 1 }
-sub warning { $RT::Logger->warning( @_ ); verbose(@_); 1 }
-
-sub show_help {
- my $error = shift;
- RT::Interface::CLI->ShowHelp(
- ExitValue => $error,
- Sections => 'NAME|DESCRIPTION',
- );
-}
-
-sub print_rt_config {
- my %args = @_;
- my $config = <<END;
-
-You can now configure RT to use the newly-created full-text index by
-adding the following to your RT_SiteConfig.pm:
-
-Set( %FullTextSearch,
- Enable => 1,
- Indexed => 1,
-END
-
- $config .= sprintf(" %-10s => '$args{$_}',\n",$_)
- foreach grep defined $args{$_}, keys %args;
- $config .= ");\n";
-
- print $config;
-}
-
-sub insert_schema {
- my $dbh = dba_handle();
- my $message = "Going to run the following in the DB:";
- my $schema = shift;
- print "$message\n";
- my $disp = $schema;
- $disp =~ s/^/ /mg;
- print "$disp\n\n";
- return if $OPT{'dryrun'};
-
- my $res = $dbh->do( $schema );
- unless ( $res ) {
- die "Couldn't run DDL query: ". $dbh->errstr;
- }
-}
-
-=head1 NAME
-
-rt-setup-fulltext-index - Create indexes for full text search
-
-=head1 DESCRIPTION
-
-This script creates the appropriate tables, columns, functions, and / or
-views necessary for full-text searching for your database type. It will
-drop any existing indexes in the process.
-
-Please read F<docs/full_text_indexing.pod> for complete documentation on
-full-text indexing for your database type.
-
-If you have a non-standard database administrator user or password, you
-may use the C<--dba> and C<--dba-password> parameters to set them
-explicitly:
-
- rt-setup-fulltext-index --dba sysdba --dba-password 'secret'
-
-To test what will happen without running any DDL, pass the C<--dryrun>
-flag.
-
-The Oracle index determines which content-types it will index at
-creation time. By default, textual message bodies and textual uploaded
-attachments (attachments with filenames) are indexed; to ignore textual
-attachments, pass the C<--no-attachments> flag when the index is
-created.
-
-
-=head1 AUTHOR
-
-Ruslan Zakirov E<lt>ruz@bestpractical.comE<gt>,
-Alex Vandiver E<lt>alexmv@bestpractical.comE<gt>
-
-=cut
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-=head1 NAME
-
-rt-shredder - Script which wipe out tickets from RT DB
-
-=head1 SYNOPSIS
-
- rt-shredder --plugin list
- rt-shredder --plugin help-Tickets
- rt-shredder --plugin 'Tickets=query,Queue="general" and Status="deleted"'
-
- rt-shredder --sqldump unshred.sql --plugin ...
- rt-shredder --force --plugin ...
-
-=head1 DESCRIPTION
-
-rt-shredder - is script that allow you to wipe out objects
-from RT DB. This script uses API that L<RT::Shredder> module adds to RT.
-Script can be used as example of usage of the shredder API.
-
-=head1 USAGE
-
-You can use several options to control which objects script
-should wipeout.
-
-=head1 OPTIONS
-
-=head2 --sqldump <filename>
-
-Outputs INSERT queries into file. This dump can be used to restore data
-after wiping out.
-
-By default creates files named F<< <ISO_date>-XXXX.sql >> in the current
-directory.
-
-=head2 --object (DEPRECATED)
-
-Option has been deprecated, use plugin C<Objects> instead.
-
-=head2 --plugin '<plugin name>[=<arg>,<val>[;<arg>,<val>]...]'
-
-You can use plugins to select RT objects with various conditions.
-See also --plugin list and --plugin help options.
-
-=head2 --plugin list
-
-Output list of the available plugins.
-
-=head2 --plugin help-<plugin name>
-
-Outputs help for specified plugin.
-
-=head2 --force
-
-Script doesn't ask any questions.
-
-=head1 SEE ALSO
-
-L<RT::Shredder>
-
-=cut
-
-use strict;
-use warnings FATAL => 'all';
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use RT -init;
-
-require RT::Shredder;
-
-use Getopt::Long qw(GetOptions);
-use File::Spec ();
-
-use RT::Shredder::Plugin ();
-# prefetch list of plugins
-our %plugins = RT::Shredder::Plugin->List;
-
-our %opt;
-parse_args();
-
-my $shredder = RT::Shredder->new;
-
-{
- my $plugin = eval { $shredder->AddDumpPlugin( Arguments => {
- file_name => $opt{'sqldump'},
- from_storage => 0,
- } ) };
- if( $@ ) {
- print STDERR "ERROR: Couldn't open SQL dump file: $@\n";
- exit 1 if $opt{'sqldump'};
-
- print STDERR "WARNING: It's strongly recommended to use '--sqldump <filename>' option\n";
- unless( $opt{'force'} ) {
- exit 0 unless prompt_yN( "Do you want to proceed?" );
- }
- } else {
- print "SQL dump file is '". $plugin->FileName ."'\n";
- }
-}
-
-my @objs = process_plugins( $shredder );
-prompt_delete_objs( \@objs ) unless $opt{'force'};
-
-$shredder->PutObjects( Objects => $_ ) foreach @objs;
-eval { $shredder->WipeoutAll };
-if( $@ ) {
- require RT::Shredder::Exceptions;
- if( my $e = RT::Shredder::Exception::Info->caught ) {
- print "\nERROR: $e\n\n";
- exit 1;
- }
- die $@;
-}
-
-sub prompt_delete_objs
-{
- my( $objs ) = @_;
- unless( @$objs ) {
- print "Objects list is empty, try refine search options\n";
- exit 0;
- }
- my $list = "Next ". scalar( @$objs ) ." objects would be deleted:\n";
- foreach my $o( @$objs ) {
- $list .= "\t". $o->_AsString ." object\n";
- }
- print $list;
- exit(0) unless prompt_yN( "Do you want to proceed?" );
-}
-
-sub prompt_yN
-{
- my $text = shift;
- print "$text [y/N] ";
- unless( <STDIN> =~ /^(?:y|yes)$/i ) {
- return 0;
- }
- return 1;
-}
-
-sub usage
-{
- require RT::Shredder::POD;
- RT::Shredder::POD::shredder_cli( $0, \*STDOUT );
- exit 1;
-}
-
-sub parse_args
-{
- my $tmp;
- Getopt::Long::Configure( "pass_through" );
- my @objs = ();
- if( GetOptions( 'object=s' => \@objs ) && @objs ) {
- print STDERR "Option --object had been deprecated, use plugin 'Objects' instead\n";
- exit(1);
- }
-
- my @plugins = ();
- if( GetOptions( 'plugin=s' => \@plugins ) && @plugins ) {
- $opt{'plugin'} = \@plugins;
- foreach my $str( @plugins ) {
- if( $str =~ /^\s*list\s*$/ ) {
- show_plugin_list();
- } elsif( $str =~ /^\s*help-(\w+)\s*$/ ) {
- show_plugin_help( $1 );
- } elsif( $str =~ /^(\w+)(=.*)?$/ && !$plugins{$1} ) {
- print "Couldn't find plugin '$1'\n";
- show_plugin_list();
- }
- }
- }
-
- # other options make no sense without previouse
- usage() unless keys %opt;
-
- if( GetOptions( 'force' => \$tmp ) && $tmp ) {
- $opt{'force'}++;
- }
- $tmp = undef;
- if( GetOptions( 'sqldump=s' => \$tmp ) && $tmp ) {
- $opt{'sqldump'} = $tmp;
- }
- return;
-}
-
-sub process_plugins
-{
- my $shredder = shift;
-
- my @res;
- foreach my $str( @{ $opt{'plugin'} } ) {
- my $plugin = RT::Shredder::Plugin->new;
- my( $status, $msg ) = $plugin->LoadByString( $str );
- unless( $status ) {
- print STDERR "Couldn't load plugin\n";
- print STDERR "Error: $msg\n";
- exit(1);
- }
- if ( lc $plugin->Type eq 'search' ) {
- push @res, _process_search_plugin( $shredder, $plugin );
- }
- elsif ( lc $plugin->Type eq 'dump' ) {
- _process_dump_plugin( $shredder, $plugin );
- }
- }
- return RT::Shredder->CastObjectsToRecords( Objects => \@res );
-}
-
-sub _process_search_plugin {
- my ($shredder, $plugin) = @_;
- my ($status, @objs) = $plugin->Run;
- unless( $status ) {
- print STDERR "Couldn't run plugin\n";
- print STDERR "Error: $objs[1]\n";
- exit(1);
- }
-
- my $msg;
- ($status, $msg) = $plugin->SetResolvers( Shredder => $shredder );
- unless( $status ) {
- print STDERR "Couldn't set conflicts resolver\n";
- print STDERR "Error: $msg\n";
- exit(1);
- }
- return @objs;
-}
-
-sub _process_dump_plugin {
- my ($shredder, $plugin) = @_;
- $shredder->AddDumpPlugin(
- Object => $plugin,
- );
-}
-
-sub show_plugin_list
-{
- print "Plugins list:\n";
- print "\t$_\n" foreach( grep !/^Base$/, keys %plugins );
- exit(1);
-}
-
-sub show_plugin_help
-{
- my( $name ) = @_;
- require RT::Shredder::POD;
- unless( $plugins{ $name } ) {
- print "Couldn't find plugin '$name'\n";
- show_plugin_list();
- }
- RT::Shredder::POD::plugin_cli( $plugins{'Base'}, \*STDOUT, 1 );
- RT::Shredder::POD::plugin_cli( $plugins{ $name }, \*STDOUT );
- exit(1);
-}
-
-exit(0);
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-#
-# This is just a basic script that checks to make sure that all
-# the modules needed by RT before you can install it.
-#
-
-use strict;
-use warnings;
-no warnings qw(numeric redefine);
-use Getopt::Long;
-use Cwd qw(abs_path);
-my %args;
-my %deps;
-my @orig_argv = @ARGV;
-# Save our path because installers or tests can change cwd
-my $script_path = abs_path($0);
-
-GetOptions(
- \%args, 'v|verbose',
- 'install!', 'with-MYSQL',
- 'with-POSTGRESQL|with-pg|with-pgsql', 'with-SQLITE',
- 'with-ORACLE', 'with-FASTCGI',
- 'with-MODPERL1', 'with-MODPERL2',
- 'with-STANDALONE',
-
- 'with-DEV',
-
- 'with-GPG',
- 'with-ICAL',
- 'with-SMTP',
- 'with-GRAPHVIZ',
- 'with-GD',
- 'with-DASHBOARDS',
- 'with-USERLOGO',
- 'with-SSL-MAILGATE',
- 'with-HTML-DOC',
-
- 'download=s',
- 'repository=s',
- 'list-deps',
- 'help|h',
-);
-
-if ( $args{help} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-# Set up defaults
-my %default = (
- 'with-MASON' => 1,
- 'with-PSGI' => 0,
- 'with-CORE' => 1,
- 'with-CLI' => 1,
- 'with-MAILGATE' => 1,
- 'with-DEV' => 0,
- 'with-GPG' => 1,
- 'with-ICAL' => 1,
- 'with-SMTP' => 1,
- 'with-GRAPHVIZ' => 1,
- 'with-GD' => 0,
- 'with-DASHBOARDS' => 1,
- 'with-USERLOGO' => 1,
- 'with-SSL-MAILGATE' => 0,
- 'with-HTML-DOC' => 0,
-);
-$args{$_} = $default{$_} foreach grep !exists $args{$_}, keys %default;
-
-{
- my $section;
- my %always_show_sections = (
- perl => 1,
- users => 1,
- );
-
- sub section {
- my $s = shift;
- $section = $s;
- print "$s:\n" unless $args{'list-deps'};
- }
-
- sub print_found {
- my $msg = shift;
- my $test = shift;
- my $extra = shift;
-
- unless ( $args{'list-deps'} ) {
- if ( $args{'v'} or not $test or $always_show_sections{$section} ) {
- print "\t$msg ...";
- print $test ? "found" : "MISSING";
- print "\n";
- }
-
- print "\t\t$extra\n" if defined $extra;
- }
- }
-}
-
-sub conclude {
- my %missing_by_type = @_;
-
- unless ( $args{'list-deps'} ) {
- unless ( keys %missing_by_type ) {
- print "\nAll dependencies have been found.\n";
- return;
- }
-
- print "\nSOME DEPENDENCIES WERE MISSING.\n";
-
- for my $type ( keys %missing_by_type ) {
- my $missing = $missing_by_type{$type};
-
- print "$type missing dependencies:\n";
- for my $name ( keys %$missing ) {
- my $module = $missing->{$name};
- my $version = $module->{version};
- my $error = $module->{error};
- print_found( $name . ( $version && !$error ? " >= $version" : "" ),
- 0, $module->{error} );
- }
- }
- exit 1;
- }
-}
-
-sub text_to_hash {
- my %hash;
- for my $line ( split /\n/, $_[0] ) {
- my($key, $value) = $line =~ /(\S+)\s*(\S*)/;
- $value ||= '';
- $hash{$key} = $value;
- }
-
- return %hash;
-}
-sub set_dep {
- my ($name, $module, $version) = @_;
- my %list = @{$deps{$name}};
- $list{$module} = ($version || '');
- $deps{$name} = [ %list ];
-}
-
-$deps{'CORE'} = [ text_to_hash( << '.') ];
-Class::Accessor 0.34
-DateTime 0.44
-DateTime::Locale 0.40
-Digest::base
-Digest::MD5 2.27
-Digest::SHA
-DBI 1.37
-Class::ReturnValue 0.40
-DBIx::SearchBuilder 1.59
-Text::Template 1.44
-File::ShareDir
-File::Spec 0.8
-HTML::Quoted
-HTML::Scrubber 0.08
-HTML::TreeBuilder
-HTML::FormatText
-Log::Dispatch 2.23
-Sys::Syslog 0.16
-Locale::Maketext 1.06
-Locale::Maketext::Lexicon 0.32
-Locale::Maketext::Fuzzy
-MIME::Entity 5.425
-Mail::Mailer 1.57
-Email::Address
-Text::Wrapper
-Time::ParseDate
-Time::HiRes
-File::Temp 0.19
-Text::Quoted 2.02
-Tree::Simple 1.04
-UNIVERSAL::require
-Regexp::Common
-Scalar::Util
-Module::Versions::Report 1.05
-Cache::Simple::TimedExpiry
-Encode 2.39
-CSS::Squish 0.06
-File::Glob
-Devel::StackTrace 1.19
-Text::Password::Pronounceable
-Devel::GlobalDestruction
-List::MoreUtils
-Net::CIDR
-Regexp::Common::net::CIDR
-Regexp::IPv6
-.
-
-$deps{'MASON'} = [ text_to_hash( << '.') ];
-HTML::Mason 1.43
-Errno
-Digest::MD5 2.27
-CGI::Cookie 1.20
-Storable 2.08
-Apache::Session 1.53
-XML::RSS 1.05
-Text::WikiFormat 0.76
-CSS::Squish 0.06
-Devel::StackTrace 1.19
-JSON
-IPC::Run3
-.
-
-$deps{'PSGI'} = [ text_to_hash( << '.') ];
-CGI 3.38
-CGI::PSGI 0.12
-HTML::Mason::PSGIHandler 0.52
-Plack 0.9971
-Plack::Handler::Starlet
-CGI::Emulate::PSGI
-.
-set_dep( PSGI => CGI => 4.00 ) if $] > 5.019003;
-
-
-$deps{'MAILGATE'} = [ text_to_hash( << '.') ];
-Getopt::Long
-LWP::UserAgent
-Pod::Usage
-.
-
-$deps{'SSL-MAILGATE'} = [ text_to_hash( << '.') ];
-Crypt::SSLeay
-Net::SSL
-LWP::UserAgent 6.0
-LWP::Protocol::https
-Mozilla::CA
-.
-
-$deps{'CLI'} = [ text_to_hash( << '.') ];
-Getopt::Long 2.24
-LWP
-HTTP::Request::Common
-Text::ParseWords
-Term::ReadLine
-Term::ReadKey
-.
-
-$deps{'DEV'} = [ text_to_hash( << '.') ];
-Email::Abstract
-Test::Email
-HTML::Form
-HTML::TokeParser
-WWW::Mechanize 1.52
-Test::WWW::Mechanize 1.30
-Module::Refresh 0.03
-Test::Expect 0.31
-XML::Simple
-File::Find
-Test::Deep 0 # needed for shredder tests
-String::ShellQuote 0 # needed for gnupg-incoming.t
-Log::Dispatch::Perl
-Test::Warn
-Test::Builder 0.90 # needed for is_passing
-Test::MockTime
-Log::Dispatch::Perl
-Test::WWW::Mechanize::PSGI
-Plack::Middleware::Test::StashWarnings 0.08
-Test::LongString
-Test::NoWarnings
-Locale::PO
-.
-
-$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
-FCGI 0.74
-FCGI::ProcManager
-.
-
-$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-Apache::Request
-Apache::DBI 0.92
-.
-
-$deps{'MODPERL2'} = [ text_to_hash( << '.') ];
-Apache::DBI
-HTML::Mason 1.36
-.
-
-$deps{'MYSQL'} = [ text_to_hash( << '.') ];
-DBD::mysql 2.1018
-.
-
-$deps{'ORACLE'} = [ text_to_hash( << '.') ];
-DBD::Oracle
-.
-
-$deps{'POSTGRESQL'} = [ text_to_hash( << '.') ];
-DBIx::SearchBuilder 1.66
-DBD::Pg 1.43
-.
-
-$deps{'SQLITE'} = [ text_to_hash( << '.') ];
-DBD::SQLite 1.00
-.
-
-$deps{'GPG'} = [ text_to_hash( << '.') ];
-GnuPG::Interface
-PerlIO::eol
-.
-
-$deps{'ICAL'} = [ text_to_hash( << '.') ];
-Data::ICal
-.
-
-$deps{'SMTP'} = [ text_to_hash( << '.') ];
-Net::SMTP
-.
-
-$deps{'DASHBOARDS'} = [ text_to_hash( << '.') ];
-HTML::RewriteAttributes 0.05
-MIME::Types
-URI 1.59
-.
-
-$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
-GraphViz
-IPC::Run 0.90
-.
-
-$deps{'GD'} = [ text_to_hash( << '.') ];
-GD
-GD::Graph
-GD::Text
-.
-
-$deps{'USERLOGO'} = [ text_to_hash( << '.') ];
-Convert::Color
-.
-
-$deps{'HTML-DOC'} = [ text_to_hash( <<'.') ];
-Pod::Simple 3.24
-HTML::Entities
-.
-
-my %AVOID = (
- 'DBD::Oracle' => [qw(1.23)],
- 'Email::Address' => [qw(1.893 1.894)],
- 'Devel::StackTrace' => [qw(1.28 1.29)],
-);
-
-if ($args{'download'}) {
- download_mods();
-}
-
-
-check_perl_version();
-
-check_users();
-
-my %Missing_By_Type = ();
-foreach my $type (sort grep $args{$_}, keys %args) {
- next unless ($type =~ /^with-(.*?)$/) and $deps{$1};
-
- $type = $1;
- section("$type dependencies");
-
- my @missing;
- my @deps = @{ $deps{$type} };
-
- my %missing = test_deps(@deps);
-
- if ( $args{'install'} ) {
- for my $module (keys %missing) {
- resolve_dep($module, $missing{$module}{version});
- my $m = $module . '.pm';
- $m =~ s!::!/!g;
- if ( delete $INC{$m} ) {
- my $symtab = $module . '::';
- no strict 'refs';
- for my $symbol ( keys %{$symtab} ) {
- next if substr( $symbol, -2, 2 ) eq '::';
- delete $symtab->{$symbol};
- }
- }
- delete $missing{$module}
- if test_dep($module, $missing{$module}{version}, $AVOID{$module});
- }
- }
-
- $Missing_By_Type{$type} = \%missing if keys %missing;
-}
-
-if ( $args{'install'} && keys %Missing_By_Type ) {
- exec($script_path, @orig_argv, '--no-install');
-}
-else {
- conclude(%Missing_By_Type);
-}
-
-sub test_deps {
- my @deps = @_;
-
- my %missing;
- while(@deps) {
- my $module = shift @deps;
- my $version = shift @deps;
- my($test, $error) = test_dep($module, $version, $AVOID{$module});
- my $msg = $module . ($version && !$error ? " >= $version" : '');
- print_found($msg, $test, $error);
-
- $missing{$module} = { version => $version, error => $error } unless $test;
- }
-
- return %missing;
-}
-
-sub test_dep {
- my $module = shift;
- my $version = shift;
- my $avoid = shift;
-
- if ( $args{'list-deps'} ) {
- print $module, ': ', $version || 0, "\n";
- }
- else {
- no warnings 'deprecated';
- eval "use $module $version ()";
- if ( my $error = $@ ) {
- return 0 unless wantarray;
-
- $error =~ s/\n(.*)$//s;
- $error =~ s/at \(eval \d+\) line \d+\.$//;
- undef $error if $error =~ /this is only/;
-
- return ( 0, $error );
- }
-
- if ( $avoid ) {
- my $version = $module->VERSION;
- if ( grep $version eq $_, @$avoid ) {
- return 0 unless wantarray;
- return (0, "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually.");
- }
- }
-
- return 1;
- }
-}
-
-sub resolve_dep {
- my $module = shift;
- my $version = shift;
-
- print "\nInstall module $module\n";
-
- my $ext = $ENV{'RT_FIX_DEPS_CMD'} || $ENV{'PERL_PREFER_CPAN_CLIENT'};
- unless( $ext ) {
- my $configured = 1;
- {
- local @INC = @INC;
- if ( $ENV{'HOME'} ) {
- unshift @INC, "$ENV{'HOME'}/.cpan";
- }
- $configured = eval { require CPAN::MyConfig } || eval { require CPAN::Config };
- }
- unless ( $configured ) {
- print <<END;
-You haven't configured the CPAN shell yet.
-Please run `/usr/bin/perl -MCPAN -e shell` to configure it.
-END
- exit(1);
- }
- my $rv = eval { require CPAN; CPAN::Shell->install($module) };
- return $rv unless $@;
-
- print <<END;
-Failed to load module CPAN.
-
--------- Error ---------
-$@
-------------------------
-
-When we tried to start installing RT's perl dependencies,
-we were unable to load the CPAN client. This module is usually distributed
-with Perl. This usually indicates that your vendor has shipped an unconfigured
-or incorrectly configured CPAN client.
-The error above may (or may not) give you a hint about what went wrong
-
-You have several choices about how to install dependencies in
-this situatation:
-
-1) use a different tool to install dependencies by running setting the following
- shell environment variable and rerunning this tool:
- RT_FIX_DEPS_CMD='/usr/bin/perl -MCPAN -e"install %s"'
-2) Attempt to configure CPAN by running:
- `/usr/bin/perl -MCPAN -e shell` program from shell.
- If this fails, you may have to manually upgrade CPAN (see below)
-3) Try to update the CPAN client. Download it from:
- http://search.cpan.org/dist/CPAN and try again
-4) Install each dependency manually by downloading them one by one from
- http://search.cpan.org
-
-END
- exit(1);
- }
-
- if( $ext =~ /\%s/) {
- $ext =~ s/\%s/$module/g; # sprintf( $ext, $module );
- } else {
- $ext .= " $module";
- }
- print "\t\tcommand: '$ext'\n";
- return scalar `$ext 1>&2`;
-}
-
-sub download_mods {
- my %modules;
- use CPAN;
-
- foreach my $key (keys %deps) {
- my @deps = (@{$deps{$key}});
- while (@deps) {
- my $mod = shift @deps;
- my $ver = shift @deps;
- next if ($mod =~ /^(DBD-|Apache-Request)/);
- $modules{$mod} = $ver;
- }
- }
- my @mods = keys %modules;
- CPAN::get();
- my $moddir = $args{'download'};
- foreach my $mod (@mods) {
- $CPAN::Config->{'build_dir'} = $moddir;
- CPAN::get($mod);
- }
-
- opendir(DIR, $moddir);
- while ( my $dir = readdir(DIR)) {
- print "Dir is $dir\n";
- next if ( $dir =~ /^\.\.?$/);
-
- # Skip things we've previously tagged
- my $out = `svn ls $args{'repository'}/tags/$dir`;
- next if ($out);
-
- if ($dir =~ /^(.*)-(.*?)$/) {
- `svn_load_dirs -no_user_input -t tags/$dir -v $args{'repository'} dists/$1 $moddir/$dir`;
- `rm -rf $moddir/$dir`;
-
- }
-
- }
- closedir(DIR);
- exit;
-}
-
-sub check_perl_version {
- section("perl");
- eval {require 5.008003};
- if ($@) {
- print_found("5.8.3", 0,"RT is known to be non-functional on versions of perl older than 5.8.3. Please upgrade to 5.8.3 or newer.");
- exit(1);
- } else {
- print_found( sprintf(">=5.8.3(%vd)", $^V), 1 );
- }
-}
-
-sub check_users {
- section("users");
- print_found("rt group (freeside)", defined getgrnam("freeside"));
- print_found("bin owner (root)", defined getpwnam("root"));
- print_found("libs owner (root)", defined getpwnam("root"));
- print_found("libs group (bin)", defined getgrnam("bin"));
- print_found("web owner (freeside)", defined getpwnam("freeside"));
- print_found("web group (freeside)", defined getgrnam("freeside"));
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-rt-test-dependencies - test rt's dependencies
-
-=head1 SYNOPSIS
-
- rt-test-dependencies
- rt-test-dependencies --install
- rt-test-dependencies --with-mysql --with-fastcgi
-
-=head1 DESCRIPTION
-
-by default, C<rt-test-dependencies> determines whether you have installed all
-the perl modules RT needs to run.
-
-the "RT_FIX_DEPS_CMD" environment variable, if set, will be used instead of
-the standard CPAN shell by --install to install any required modules. it will
-be called with the module name, or, if "RT_FIX_DEPS_CMD" contains a "%s", will
-replace the "%s" with the module name before calling the program.
-
-=head1 OPTIONS
-
-=over
-
-=item install
-
- install missing modules
-
-=item verbose
-
-list the status of all dependencies, rather than just the missing ones.
-
--v is equal to --verbose
-
-=item specify dependencies
-
-=over
-
-=item --with-mysql
-
- database interface for mysql
-
-=item --with-postgresql
-
- database interface for postgresql
-
-=item with-oracle
-
- database interface for oracle
-
-=item with-sqlite
-
- database interface and driver for sqlite (unsupported)
-
-=item with-fastcgi
-
- libraries needed to support the fastcgi handler
-
-=item with-modperl1
-
- libraries needed to support the modperl 1 handler
-
-=item with-modperl2
-
- libraries needed to support the modperl 2 handler
-
-=item with-dev
-
- tools needed for RT development
-
-=back
-
-=back
-
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-use Text::ParseWords qw//;
-use Getopt::Long;
-
-BEGIN { # BEGIN RT CMD BOILERPLATE
- require File::Spec;
- require Cwd;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1];
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-}
-
-require RT;
-RT::LoadConfig();
-RT::Init();
-
-my ($PREFIX, $URL, $HOST) = ("");
-GetOptions(
- "prefix|p=s" => \$PREFIX,
- "url|u=s" => \$URL,
- "host|h=s" => \$HOST,
-);
-
-unless (@ARGV) {
- @ARGV = grep {-f} ("/etc/aliases",
- "/etc/mail/aliases",
- "/etc/postfix/aliases");
- die "Can't determine aliases file to parse!"
- unless @ARGV;
-}
-
-my %aliases = parse_lines();
-unless (%aliases) {
- warn "No mailgate aliases found in @ARGV";
- exit;
-}
-
-my %seen;
-my $global_mailgate;
-for my $address (sort keys %aliases) {
- my ($mailgate, $opts, $extra) = @{$aliases{$address}};
- my %opts = %{$opts};
-
- next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/;
-
- if ($mailgate !~ /^\|/) {
- warn "Missing the leading | on alias $address\n";
- $mailgate = "|$mailgate";
- }
- if (($global_mailgate ||= $mailgate) ne $mailgate) {
- warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n";
- }
-
- if (not defined $opts{action}) {
- warn "Missing --action parameter for alias $address\n";
- } elsif ($opts{action} !~ /^(correspond|comment)$/) {
- warn "Invalid --action parameter for alias $address: $opts{action}\n"
- }
-
- my $queue = RT::Queue->new( RT->SystemUser );
- if (not defined $opts{queue}) {
- warn "Missing --queue parameter for alias $address\n";
- } else {
- $queue->Load( $opts{queue} );
- if (not $queue->id) {
- warn "Invalid --queue parameter for alias $address: $opts{queue}\n";
- } elsif ($queue->Disabled) {
- warn "Disabled --queue given for alias $address: $opts{queue}\n";
- }
- }
-
- if (not defined $opts{url}) {
- warn "Missing --url parameter for alias $address\n";
- } #XXX: Test connectivity and/or https certs?
-
- if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) {
- push @{$seen{lc $queue->Name}{$opts{action}}}, $address;
- }
-
- warn "Unknown extra arguments for alias $address: @{$extra}\n"
- if @{$extra};
-}
-
-# Check the global settings
-my %global;
-for my $action (qw/correspond comment/) {
- my $setting = ucfirst($action) . "Address";
- my $value = RT->Config->Get($setting);
- if (not defined $value) {
- warn "$setting is not set!\n";
- next;
- }
- my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/;
- next if $HOST and $host !~ /\Q$HOST\E/;
- $local = "$PREFIX$local" unless exists $aliases{$local};
-
- $global{$setting} = $local;
- if (not exists $aliases{$local}) {
- warn "$setting $value does not exist in aliases!\n"
- } elsif ($aliases{$local}[1]{action} ne $action) {
- warn "$setting $value is a $aliases{$local}[1]{action} in aliases!"
- }
-}
-warn "CorrespondAddress and CommentAddress are the same!\n"
- if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress");
-
-
-# Go through the queues, one at a time
-my $queues = RT::Queues->new( RT->SystemUser );
-$queues->UnLimit;
-while (my $q = $queues->Next) {
- my $qname = $q->Name;
- for my $action (qw/correspond comment/) {
- my $setting = ucfirst($action) . "Address";
- my $value = $q->$setting;
-
- if (not $value) {
- my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []};
- warn "CorrespondAddress not set on $qname, but in aliases as "
- .join(" and ", @other) . "\n" if @other;
- next;
- }
-
- if ($action eq "comment" and $q->CorrespondAddress
- and $q->CorrespondAddress eq $q->CommentAddress) {
- warn "CorrespondAddress and CommentAddress are set the same on $qname\n";
- next;
- }
-
- my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/;
- next if $HOST and $host !~ /\Q$HOST\E/;
- $local = "$PREFIX$local" unless exists $aliases{$local};
-
- my @other = @{$seen{lc $q->Name}{$action} || []};
- if (not exists $aliases{$local}) {
- if (@other) {
- warn "$setting $value on $qname does not exist in aliases -- typo'd as "
- .join(" or ", @other) . "?\n";
- } else {
- warn "$setting $value on $qname does not exist in aliases!\n"
- }
- next;
- }
-
- my %opt = %{$aliases{$local}[1]};
- if ($opt{action} ne $action) {
- warn "$setting address $value on $qname is a $opt{action} in aliases!\n"
- }
- if (lc $opt{queue} ne lc $q->Name and $action ne "comment") {
- warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n";
- }
-
- @other = grep {$_ ne $local} @other;
- warn "Extra aliases for queue $qname: ".join(",",@other)."\n"
- if @other;
- }
-}
-
-
-sub parse_lines {
- local @ARGV = @ARGV;
-
- my %aliases;
- my $line = "";
- for (<>) {
- next unless /\S/;
- next if /^#/;
- chomp;
- if (/^\s+/) {
- $line .= $_;
- } else {
- add_line($line, \%aliases);
- $line = $_;
- }
- }
- add_line($line, \%aliases);
-
- expand(\%aliases);
- filter_mailgate(\%aliases);
-
- return %aliases;
-}
-
-sub expand {
- my ($data) = @_;
-
- for (1..100) {
- my $expanded = 0;
- for my $address (sort keys %{$data}) {
- my @new;
- for my $part (@{$data->{$address}}) {
- if (m!^[|/]! or not $data->{$part}) {
- push @new, $part;
- } else {
- $expanded++;
- push @new, @{$data->{$part}};
- }
- }
- $data->{$address} = \@new;
- }
- return unless $expanded;
- }
- warn "Recursion limit exceeded -- cycle in aliases?\n";
-}
-
-sub filter_mailgate {
- my ($data) = @_;
-
- for my $address (sort keys %{$data}) {
- my @parts = @{delete $data->{$address}};
-
- my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts;
- next unless @pipes;
-
- my $pipe = shift @pipes;
- warn "More than one rt-mailgate pipe for alias: $address\n"
- if @pipes;
-
- my @args = Text::ParseWords::shellwords($pipe);
-
- # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...",
- # we just need to strip off enough
- my $index = 0;
- $index++ while $args[$index] !~ m!/rt-mailgate!;
- my $mailgate = join(' ', splice(@args,0,$index+1));
-
- my %opts;
- local @ARGV = @args;
- Getopt::Long::Configure( "pass_through" ); # Allow unknown options
- my $ret = eval {
- GetOptions( \%opts, "queue=s", "action=s", "url=s",
- "jar=s", "debug", "extension=s",
- "timeout=i", "verify-ssl!", "ca-file=s",
- );
- 1;
- };
- warn "Failed to parse options for $address: $@" unless $ret;
- next unless %opts;
-
- $data->{lc $address} = [$mailgate, \%opts, [@ARGV]];
- }
-}
-
-sub add_line {
- my ($line, $data) = @_;
- return unless $line =~ /\S/;
-
- my ($name, $parts) = parse_line($line);
- return unless defined $name;
-
- if (defined $data->{$name}) {
- warn "Duplicate definition for alias $name\n";
- return;
- }
-
- $data->{lc $name} = $parts;
-}
-
-sub parse_line {
- my $re_name = qr/\S+/;
- # Intentionally accept pipe-like aliases with a missing | -- we deal with them later
- my $re_quoted_pipe = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/;
- my $re_nonquoted_pipe = qr/\|[^\s,]+/;
- my $re_pipe = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/;
- my $re_path = qr!/[^,\s]+!;
- my $re_address = qr![^|/,\s][^,\s]*!;
- my $re_value = qr/(?:$re_pipe|$re_path|$re_address)/;
- my $re_values = qr/(?:$re_value(?:\s*,\s*$re_value)*)/;
-
- my ($line) = @_;
- if ($line =~ /^($re_name):\s*($re_values)/) {
- my ($name, $all_parts) = ($1, $2);
- my @parts;
- while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) {
- my $part = $1;
- if ($part =~ /^"/) {
- $part =~ s/^"//; $part =~ s/"$//;
- $part =~ s/\\(.)/$1/g;
- }
- push @parts, $part;
- }
- return $name, [@parts];
- } else {
- warn "Parse failure, line $. of $ARGV: $line\n";
- return ();
- }
-}
+++ /dev/null
-#!/usr/bin/perl
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use strict;
-use warnings;
-
-# fix lib paths, some may be relative
-BEGIN {
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-my %opt = ();
-GetOptions(
- \%opt,
- 'check|c',
- 'resolve',
- 'force',
- 'verbose|v',
- 'help|h',
-);
-
-if ( $opt{help} || !$opt{check} ) {
- require Pod::Usage;
- print Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-usage_warning() if $opt{'resolve'} && !$opt{'force'};
-
-
-sub usage_warning {
- print <<END;
-This utility can fix some issues with DB by creating or updating. In some
-cases there is no enough data to resurect a missing record, but records which
-refers to a missing can be deleted. It's up to you to decide what to do.
-
-In any case it's highly recommended to have a backup before resolving anything.
-
-Press enter to continue.
-END
-# Read a line of text, any line of text
- <STDIN>;
-}
-
-use RT;
-RT::LoadConfig();
-RT::Init();
-
-my $dbh = $RT::Handle->dbh;
-my $db_type = RT->Config->Get('DatabaseType');
-
-my %TYPE = (
- 'Transactions.Field' => 'text',
- 'Transactions.OldValue' => 'text',
- 'Transactions.NewValue' => 'text',
-);
-
-my @models = qw(
- ACE
- Attachment
- Attribute
- CachedGroupMember
- CustomField
- CustomFieldValue
- GroupMember
- Group
- Link
- ObjectCustomField
- ObjectCustomFieldValue
- Principal
- Queue
- ScripAction
- ScripCondition
- Scrip
- Template
- Ticket
- Transaction
- User
-);
-
-my %redo_on;
-$redo_on{'Delete'} = {
- ACL => [],
-
- Attributes => [],
-
- Links => [],
-
- CustomFields => [],
- CustomFieldValues => [],
- ObjectCustomFields => [],
- ObjectCustomFieldValues => [],
-
- Queues => [],
-
- Scrips => [],
- ScripActions => [],
- ScripConditions => [],
- Templates => [],
-
- Tickets => [ 'Tickets -> other', 'Tickets <-> Role Groups' ],
- Transactions => [ 'Attachments -> other' ],
-
- Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
- Users => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'Principals -> Users' ],
- Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM', 'Principals -> Groups' ],
-
- GroupMembers => [ 'CGM vs. GM' ],
- CachedGroupMembers => [ 'CGM vs. GM' ],
-};
-$redo_on{'Create'} = {
- Principals => ['User <-> ACL equivalence group', 'GMs -> Groups, Members' ],
- Groups => ['User <-> ACL equivalence group', 'GMs -> Groups, Members', 'CGM vs. GM' ],
- GroupMembers => [ 'CGM vs. GM' ],
- CachedGroupMembers => [ 'CGM vs. GM' ],
-};
-$redo_on{'Update'} = {
- Groups => ['User Defined Group Name uniqueness'],
-};
-
-my %describe_cb;
-%describe_cb = (
- Attachments => sub {
- my $row = shift;
- my $txn_id = $row->{transactionid};
- my $res = 'Attachment #'. $row->{id} .' -> Txn #'. $txn_id;
- return $res .', '. describe( 'Transactions', $txn_id );
- },
- Transactions => sub {
- my $row = shift;
- return 'Transaction #'. $row->{id} .' -> object '. $row->{objecttype} .' #'. $row->{objectid};
- },
-);
-
-{ my %cache = ();
-sub m2t($) {
- my $model = shift;
- return $cache{$model} if $cache{$model};
- my $class = "RT::$model";
- my $object = $class->new( RT->SystemUser );
- return $cache{$model} = $object->Table;
-} }
-
-my (@do_check, %redo_check);
-
-my @CHECKS;
-foreach my $table ( qw(Users Groups) ) {
- push @CHECKS, "$table -> Principals" => sub {
- my $msg = "A record in $table refers to a nonexistent record in Principals."
- ." The script can either create the missing record in Principals"
- ." or delete the record in $table.";
- my ($type) = ($table =~ /^(.*)s$/);
- check_integrity(
- $table, 'id' => 'Principals', 'id',
- join_condition => 't.PrincipalType = ?',
- bind_values => [ $type ],
- action => sub {
- my $id = shift;
- return unless my $a = prompt_action( ['Create', 'delete'], $msg );
-
- if ( $a eq 'd' ) {
- delete_record( $table, $id );
- }
- elsif ( $a eq 'c' ) {
- my $principal_id = create_record( 'Principals',
- id => $id, PrincipalType => $type, ObjectId => $id, Disabled => 0
- );
- }
- else {
- die "Unknown action '$a'";
- }
- },
- );
- };
-
- push @CHECKS, "Principals -> $table" => sub {
- my $msg = "A record in Principals refers to a nonexistent record in $table."
- ." In some cases it's possible to manually resurrect such records,"
- ." but this utility can only delete records.";
-
- check_integrity(
- 'Principals', 'id' => $table, 'id',
- condition => 's.PrincipalType = ?',
- bind_values => [ $table =~ /^(.*)s$/ ],
- action => sub {
- my $id = shift;
- return unless prompt( 'Delete', $msg );
-
- delete_record( 'Principals', $id );
- },
- );
- };
-}
-
-push @CHECKS, 'User <-> ACL equivalence group' => sub {
- # from user to group
- check_integrity(
- 'Users', 'id' => 'Groups', 'Instance',
- join_condition => 't.Domain = ? AND t.Type = ?',
- bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Create', "Found an user that has no ACL equivalence group."
- );
-
- my $gid = create_record( 'Groups',
- Domain => 'ACLEquivalence', Type => 'UserEquiv', Instance => $id,
- );
- },
- );
- # from group to user
- check_integrity(
- 'Groups', 'Instance' => 'Users', 'id',
- condition => 's.Domain = ? AND s.Type = ?',
- bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found an user ACL equivalence group, but there is no user."
- );
-
- delete_record( 'Groups', $id );
- },
- );
- # one ACL equiv group for each user
- check_uniqueness(
- 'Groups',
- columns => ['Instance'],
- condition => '.Domain = ? AND .Type = ?',
- bind_values => [ 'ACLEquivalence', 'UserEquiv' ],
- );
-};
-
-# check integrity of Queue role groups
-push @CHECKS, 'Queues <-> Role Groups' => sub {
- # XXX: we check only that there is at least one group for a queue
- # from queue to group
- check_integrity(
- 'Queues', 'id' => 'Groups', 'Instance',
- join_condition => 't.Domain = ?',
- bind_values => [ 'RT::Queue-Role' ],
- );
- # from group to queue
- check_integrity(
- 'Groups', 'Instance' => 'Queues', 'id',
- condition => 's.Domain = ?',
- bind_values => [ 'RT::Queue-Role' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a role group of a nonexistent queue."
- );
-
- delete_record( 'Groups', $id );
- },
- );
-};
-
-# check integrity of Ticket role groups
-push @CHECKS, 'Tickets <-> Role Groups' => sub {
- # XXX: we check only that there is at least one group for a queue
- # from queue to group
- check_integrity(
- 'Tickets', 'id' => 'Groups', 'Instance',
- join_condition => 't.Domain = ?',
- bind_values => [ 'RT::Ticket-Role' ],
- );
- # from group to ticket
- check_integrity(
- 'Groups', 'Instance' => 'Tickets', 'id',
- condition => 's.Domain = ?',
- bind_values => [ 'RT::Ticket-Role' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a role group of a nonexistent ticket."
- );
-
- delete_record( 'Groups', $id );
- },
- );
-};
-
-# additional CHECKS on groups
-push @CHECKS, 'Role Groups (Instance, Type) uniqueness' => sub {
- # Check that Domain, Instance and Type are unique
- check_uniqueness(
- 'Groups',
- columns => ['Domain', 'Instance', 'Type'],
- condition => '.Domain LIKE ?',
- bind_values => [ '%-Role' ],
- );
-};
-
-push @CHECKS, 'System internal group uniqueness' => sub {
- check_uniqueness(
- 'Groups',
- columns => ['Instance', 'Type'],
- condition => '.Domain = ?',
- bind_values => [ 'SystemInternal' ],
- );
-};
-
-# CHECK that user defined group names are unique
-push @CHECKS, 'User Defined Group Name uniqueness' => sub {
- check_uniqueness(
- 'Groups',
- columns => ['Name'],
- condition => '.Domain = ?',
- bind_values => [ 'UserDefined' ],
- extra_tables => ['Principals sp', 'Principals tp'],
- extra_condition => join(" and ", map { "$_.id = ${_}p.ObjectId and ${_}p.PrincipalType = ? and ${_}p.Disabled != 1" } qw(s t)),
- extra_values => ['Group', 'Group'],
- action => sub {
- return unless prompt(
- 'Rename', "Found a user defined group with a non-unique Name."
- );
-
- my $id = shift;
- my %cols = @_;
- update_records('Groups', { id => $id }, { Name => join('-', $cols{'Name'}, $id) });
- },
- );
-};
-
-push @CHECKS, 'GMs -> Groups, Members' => sub {
- my $msg = "A record in GroupMembers references an object that doesn't exist."
- ." Maybe you deleted a group or principal directly from the database?"
- ." Usually it's OK to delete such records.";
- check_integrity(
- 'GroupMembers', 'GroupId' => 'Groups', 'id',
- action => sub {
- my $id = shift;
- return unless prompt( 'Delete', $msg );
-
- delete_record( 'GroupMembers', $id );
- },
- );
- check_integrity(
- 'GroupMembers', 'MemberId' => 'Principals', 'id',
- action => sub {
- my $id = shift;
- return unless prompt( 'Delete', $msg );
-
- delete_record( 'GroupMembers', $id );
- },
- );
-};
-
-# CGM and GM
-push @CHECKS, 'CGM vs. GM' => sub {
- # all GM record should be duplicated in CGM
- check_integrity(
- GroupMembers => ['GroupId', 'MemberId'],
- CachedGroupMembers => ['GroupId', 'MemberId'],
- join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Create',
- "Found a record in GroupMembers that has no direct duplicate in CachedGroupMembers table."
- );
-
- my $gm = RT::GroupMember->new( RT->SystemUser );
- $gm->Load( $id );
- die "Couldn't load GM record #$id" unless $gm->id;
- my $cgm = create_record( 'CachedGroupMembers',
- GroupId => $gm->GroupId, MemberId => $gm->MemberId,
- ImmediateParentId => $gm->GroupId, Via => undef,
- Disabled => 0, # XXX: we should check integrity of Disabled field
- );
- update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
- },
- );
- # all first level CGM records should have a GM record
- check_integrity(
- CachedGroupMembers => ['GroupId', 'MemberId'],
- GroupMembers => ['GroupId', 'MemberId'],
- condition => 's.ImmediateParentId = s.GroupId AND s.Via = s.id AND s.GroupId != s.MemberId',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a record in CachedGroupMembers for a (Group, Member) pair"
- ." that doesn't exist in the GroupMembers table."
- );
-
- delete_record( 'CachedGroupMembers', $id );
- },
- );
- # each group should have a CGM record where MemberId == GroupId
- check_integrity(
- Groups => ['id', 'id'],
- CachedGroupMembers => ['GroupId', 'MemberId'],
- join_condition => 't.ImmediateParentId = t.GroupId AND t.Via = t.id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Create',
- "Found a record in Groups that has no direct"
- ." duplicate in CachedGroupMembers table."
- );
-
- my $g = RT::Group->new( RT->SystemUser );
- $g->Load( $id );
- die "Couldn't load group #$id" unless $g->id;
- die "Loaded group by $id has id ". $g->id unless $g->id == $id;
- my $cgm = create_record( 'CachedGroupMembers',
- GroupId => $id, MemberId => $id,
- ImmediateParentId => $id, Via => undef,
- Disabled => $g->Disabled,
- );
- update_records( "CachedGroupMembers", { id => $cgm }, { Via => $cgm } );
- },
- );
-
- # and back, each record in CGM with MemberId == GroupId without exceptions
- # should reference a group
- check_integrity(
- CachedGroupMembers => ['GroupId', 'MemberId'],
- Groups => ['id', 'id'],
- condition => "s.GroupId = s.MemberId",
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a record in CachedGroupMembers for a group that doesn't exist."
- );
-
- delete_record( 'CachedGroupMembers', $id );
- },
- );
- # Via
- check_integrity(
- CachedGroupMembers => 'Via',
- CachedGroupMembers => 'id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a record in CachedGroupMembers with Via that references a nonexistent record."
- );
-
- delete_record( 'CachedGroupMembers', $id );
- },
- );
-
- # for every CGM where ImmediateParentId != GroupId there should be
- # matching parent record (first level)
- check_integrity(
- CachedGroupMembers => ['ImmediateParentId', 'MemberId'],
- CachedGroupMembers => ['GroupId', 'MemberId'],
- join_condition => 't.Via = t.id',
- condition => 's.ImmediateParentId != s.GroupId',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
- );
-
- delete_record( 'CachedGroupMembers', $id );
- },
- );
-
- # for every CGM where ImmediateParentId != GroupId there should be
- # matching "grand" parent record
- check_integrity(
- CachedGroupMembers => ['GroupId', 'ImmediateParentId', 'Via'],
- CachedGroupMembers => ['GroupId', 'MemberId', 'id'],
- condition => 's.ImmediateParentId != s.GroupId',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a record in CachedGroupMembers that references a nonexistent record in CachedGroupMembers table."
- );
-
- delete_record( 'CachedGroupMembers', $id );
- },
- );
-
- # CHECK recursive records:
- # if we have CGM1 (G1,M1,V1,IP1) then for every GM2(G2, M2), where G2 == M1,
- # we should have CGM3 where G3 = G1, M3 = M2, V3 = ID1, IP3 = M1
- {
- my $query = <<END;
-SELECT cgm1.GroupId, gm2.MemberId, cgm1.id AS Via,
- cgm1.MemberId AS ImmediateParentId, cgm1.Disabled
-FROM
- CachedGroupMembers cgm1
- CROSS JOIN GroupMembers gm2
- LEFT JOIN CachedGroupMembers cgm3 ON (
- cgm3.GroupId = cgm1.GroupId
- AND cgm3.MemberId = gm2.MemberId
- AND cgm3.Via = cgm1.id
- AND cgm3.ImmediateParentId = cgm1.MemberId )
-WHERE cgm1.GroupId != cgm1.MemberId
-AND gm2.GroupId = cgm1.MemberId
-AND cgm3.id IS NULL
-END
-
- my $action = sub {
- my %props = @_;
- return unless prompt(
- 'Create',
- "Found records in CachedGroupMembers table without recursive duplicates."
- );
- my $cgm = create_record( 'CachedGroupMembers', %props );
- };
-
- my $sth = execute_query( $query );
- while ( my ($g, $m, $via, $ip, $dis) = $sth->fetchrow_array ) {
- print STDERR "Principal #$m is member of #$ip when #$ip is member of #$g,";
- print STDERR " but there is no cached GM record that $m is member of #$g.\n";
- $action->(
- GroupId => $g, MemberId => $m, Via => $via,
- ImmediateParentId => $ip, Disabled => $dis,
- );
- }
- }
-};
-
-# Tickets
-push @CHECKS, 'Tickets -> other' => sub {
- check_integrity(
- 'Tickets', 'EffectiveId' => 'Tickets', 'id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete',
- "Found a ticket that's been merged into a ticket that no longer exists."
- );
-
- delete_record( 'Tickets', $id );
- },
- );
- check_integrity(
- 'Tickets', 'Queue' => 'Queues', 'id',
- );
- check_integrity(
- 'Tickets', 'Owner' => 'Users', 'id',
- );
- # XXX: check that owner is only member of owner role group
-};
-
-
-push @CHECKS, 'Transactions -> other' => sub {
- foreach my $model ( @models ) {
- check_integrity(
- 'Transactions', 'ObjectId' => m2t($model), 'id',
- condition => 's.ObjectType = ?',
- bind_values => [ "RT::$model" ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction without object."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- }
- # type = CustomField
- check_integrity(
- 'Transactions', 'Field' => 'CustomFields', 'id',
- condition => 's.Type = ?',
- bind_values => [ 'CustomField' ],
- );
- # type = Take, Untake, Force, Steal or Give
- check_integrity(
- 'Transactions', 'OldValue' => 'Users', 'id',
- condition => 's.Type IN (?, ?, ?, ?, ?)',
- bind_values => [ qw(Take Untake Force Steal Give) ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction regarding Owner changes,"
- ." but the User with id stored in OldValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- check_integrity(
- 'Transactions', 'NewValue' => 'Users', 'id',
- condition => 's.Type IN (?, ?, ?, ?, ?)',
- bind_values => [ qw(Take Untake Force Steal Give) ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction regarding Owner changes,"
- ." but the User with id stored in NewValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- # type = DelWatcher
- check_integrity(
- 'Transactions', 'OldValue' => 'Principals', 'id',
- condition => 's.Type = ?',
- bind_values => [ 'DelWatcher' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction describing watcher changes,"
- ." but the User with id stored in OldValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- # type = AddWatcher
- check_integrity(
- 'Transactions', 'NewValue' => 'Principals', 'id',
- condition => 's.Type = ?',
- bind_values => [ 'AddWatcher' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction describing watcher changes,"
- ." but the User with id stored in NewValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
-
-# XXX: Links need more love, uri is stored instead of id
-# # type = DeleteLink
-# check_integrity(
-# 'Transactions', 'OldValue' => 'Links', 'id',
-# condition => 's.Type = ?',
-# bind_values => [ 'DeleteLink' ],
-# );
-# # type = AddLink
-# check_integrity(
-# 'Transactions', 'NewValue' => 'Links', 'id',
-# condition => 's.Type = ?',
-# bind_values => [ 'AddLink' ],
-# );
-
- # type = Set, Field = Queue
- check_integrity(
- 'Transactions', 'NewValue' => 'Queues', 'id',
- condition => 's.Type = ? AND s.Field = ?',
- bind_values => [ 'Set', 'Queue' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction describing a queue change,"
- ." but the Queue with id stored in the NewValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- check_integrity(
- 'Transactions', 'OldValue' => 'Queues', 'id',
- condition => 's.Type = ? AND s.Field = ?',
- bind_values => [ 'Set', 'Queue' ],
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found a transaction describing a queue change,"
- ." but the Queue with id stored in the OldValue column doesn't exist anymore."
- );
-
- delete_record( 'Transactions', $id );
- },
- );
- # Reminders
- check_integrity(
- 'Transactions', 'NewValue' => 'Tickets', 'id',
- join_condition => 't.Type = ?',
- condition => 's.Type IN (?, ?, ?)',
- bind_values => [ 'reminder', 'AddReminder', 'OpenReminder', 'ResolveReminder' ],
- );
-};
-
-# Attachments
-push @CHECKS, 'Attachments -> other' => sub {
- check_integrity(
- Attachments => 'TransactionId', Transactions => 'id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found an attachment without a transaction."
- );
- delete_record( 'Attachments', $id );
- },
- );
- check_integrity(
- Attachments => 'Parent', Attachments => 'id',
- action => sub {
- my $id = shift;
- return unless prompt(
- 'Delete', "Found an sub-attachment without its parent attachment."
- );
- delete_record( 'Attachments', $id );
- },
- );
- check_integrity(
- Attachments => 'Parent',
- Attachments => 'id',
- join_condition => 's.TransactionId = t.TransactionId',
- );
-};
-
-push @CHECKS, 'CustomFields and friends' => sub {
- #XXX: ObjectCustomFields needs more love
- check_integrity(
- 'CustomFieldValues', 'CustomField' => 'CustomFields', 'id',
- );
- check_integrity(
- 'ObjectCustomFieldValues', 'CustomField' => 'CustomFields', 'id',
- );
- foreach my $model ( @models ) {
- check_integrity(
- 'ObjectCustomFieldValues', 'ObjectId' => m2t($model), 'id',
- condition => 's.ObjectType = ?',
- bind_values => [ "RT::$model" ],
- );
- }
-};
-
-push @CHECKS, Templates => sub {
- check_integrity(
- 'Templates', 'Queue' => 'Queues', 'id',
- );
-};
-
-push @CHECKS, Scrips => sub {
- check_integrity(
- 'Scrips', 'Queue' => 'Queues', 'id',
- );
- check_integrity(
- 'Scrips', 'ScripCondition' => 'ScripConditions', 'id',
- );
- check_integrity(
- 'Scrips', 'ScripAction' => 'ScripActions', 'id',
- );
- check_integrity(
- 'Scrips', 'Template' => 'Templates', 'id',
- );
-};
-
-push @CHECKS, Attributes => sub {
- foreach my $model ( @models ) {
- check_integrity(
- 'Attributes', 'ObjectId' => m2t($model), 'id',
- condition => 's.ObjectType = ?',
- bind_values => [ "RT::$model" ],
- );
- }
-};
-
-# Fix situations when Creator or LastUpdatedBy references ACL equivalence
-# group of a user instead of user
-push @CHECKS, 'FIX: LastUpdatedBy and Creator' => sub {
- my %fix = ();
- foreach my $model ( @models ) {
- my $class = "RT::$model";
- my $object = $class->new( RT->SystemUser );
- foreach my $column ( qw(LastUpdatedBy Creator) ) {
- next unless $object->_Accessible( $column, 'auto' );
-
- my $table = m2t($model);
- my $query = <<END;
-SELECT m.id, g.id, g.Instance
-FROM
- Groups g JOIN $table m ON g.id = m.$column
-WHERE
- g.Domain = ?
- AND g.Type = ?
-END
- my $action = sub {
- my ($gid, $uid) = @_;
- return unless prompt(
- 'Update',
- "Looks like there were a bug in old versions of RT back in 2006\n"
- ."that has been fixed. If other checks are ok then it's ok to update\n"
- ."these records to point them to users instead of groups"
- );
- $fix{ $table }{ $column }{ $gid } = $uid;
- };
-
- my $sth = execute_query( $query, 'ACLEquivalence', 'UserEquiv' );
- while ( my ($rid, $gid, $uid) = $sth->fetchrow_array ) {
- print STDERR "Record #$rid in $table refers to ACL equivalence group #$gid of user #$uid";
- print STDERR " when must reference user.\n";
- $action->( $gid, $uid );
- if ( keys( %fix ) > 1000 ) {
- $sth->finish;
- last;
- }
- }
- }
- }
-
- if ( keys %fix ) {
- foreach my $table ( keys %fix ) {
- foreach my $column ( keys %{ $fix{ $table } } ) {
- my $query = "UPDATE $table SET $column = ? WHERE $column = ?";
- while ( my ($gid, $uid) = each %{ $fix{ $table }{ $column } } ) {
- update_records( $table, { $column => $gid }, { $column => $uid } );
- }
- }
- }
- $redo_check{'FIX: LastUpdatedBy and Creator'} = 1;
- }
-};
-
-push @CHECKS, 'LastUpdatedBy and Creator' => sub {
- foreach my $model ( @models ) {
- my $class = "RT::$model";
- my $object = $class->new( RT->SystemUser );
- my $table = $object->Table;
- foreach my $column ( qw(LastUpdatedBy Creator) ) {
- next unless $object->_Accessible( $column, 'auto' );
- check_integrity(
- $table, $column => 'Users', 'id',
- action => sub {
- my ($id, %prop) = @_;
- return unless my $replace_with = prompt_integer(
- 'Replace',
- "Column $column should point to a user, but there is record #$id in table $table\n"
- ."where it's not true. It's ok to replace these wrong references with id of any user.\n"
- ."Note that id you enter is not checked. You can pick any user from your DB, but it's\n"
- ."may be better to create a special user for this, for example 'user_that_has_been_deleted'\n"
- ."or something like that.",
- "$table.$column -> user #$prop{$column}"
- );
- update_records( $table, { id => $id, $column => $prop{$column} }, { $column => $replace_with } );
- },
- );
- }
- }
-};
-my %CHECKS = @CHECKS;
-
-@do_check = do { my $i = 1; grep $i++%2, @CHECKS };
-
-while ( my $check = shift @do_check ) {
- $CHECKS{ $check }->();
-
- foreach my $redo ( keys %redo_check ) {
- die "check $redo doesn't exist" unless $CHECKS{ $redo };
- delete $redo_check{ $redo };
- next if grep $_ eq $redo, @do_check; # don't do twice
- push @do_check, $redo;
- }
-}
-
-sub check_integrity {
- my ($stable, @scols) = (shift, shift);
- my ($ttable, @tcols) = (shift, shift);
- my %args = @_;
-
- @scols = @{ $scols[0] } if ref $scols[0];
- @tcols = @{ $tcols[0] } if ref $tcols[0];
-
- print "Checking integrity of $stable.{". join(', ', @scols) ."} => $ttable.{". join(', ', @tcols) ."}\n"
- if $opt{'verbose'};
-
- my $query = "SELECT s.id, ". join(', ', map "s.$_", @scols)
- ." FROM $stable s LEFT JOIN $ttable t"
- ." ON (". join(
- ' AND ', map columns_eq_cond('s', $stable, $scols[$_] => 't', $ttable, $tcols[$_]), (0..(@scols-1))
- ) .")"
- . ($args{'join_condition'}? " AND ( $args{'join_condition'} )": "")
- ." WHERE t.id IS NULL"
- ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @scols);
-
- $query .= " AND ( $args{'condition'} )" if $args{'condition'};
-
- my @binds = @{ $args{'bind_values'} || [] };
- if ( $tcols[0] eq 'id' && @tcols == 1 ) {
- my $type = $TYPE{"$stable.$scols[0]"} || 'number';
- if ( $type eq 'number' ) {
- $query .= " AND s.$scols[0] != ?"
- }
- elsif ( $type eq 'text' ) {
- $query .= " AND s.$scols[0] NOT LIKE ?"
- }
- push @binds, 0;
- }
-
- my $sth = execute_query( $query, @binds );
- while ( my ($sid, @set) = $sth->fetchrow_array ) {
- print STDERR "Record #$sid in $stable references a nonexistent record in $ttable\n";
- for ( my $i = 0; $i < @scols; $i++ ) {
- print STDERR "\t$scols[$i] => '$set[$i]' => $tcols[$i]\n";
- }
- print STDERR "\t". describe( $stable, $sid ) ."\n";
- $args{'action'}->( $sid, map { $scols[$_] => $set[$_] } (0 .. (@scols-1)) ) if $args{'action'};
- }
-}
-
-sub describe {
- my ($table, $id) = @_;
- return '' unless my $cb = $describe_cb{ $table };
-
- my $row = load_record( $table, $id );
- unless ( $row->{id} ) {
- $table =~ s/s$//;
- return "$table doesn't exist";
- }
- return $cb->( $row );
-}
-
-sub columns_eq_cond {
- my ($la, $lt, $lc, $ra, $rt, $rc) = @_;
- my $ltype = $TYPE{"$lt.$lc"} || 'number';
- my $rtype = $TYPE{"$rt.$rc"} || 'number';
- return "$la.$lc = $ra.$rc" if $db_type ne 'Pg' || $ltype eq $rtype;
-
- if ( $rtype eq 'text' ) {
- return "$ra.$rc LIKE CAST($la.$lc AS text)";
- }
- elsif ( $ltype eq 'text' ) {
- return "$la.$lc LIKE CAST($ra.$rc AS text)";
- }
- else { die "don't know how to cast" }
-}
-
-sub check_uniqueness {
- my $on = shift;
- my %args = @_;
-
- my @columns = @{ $args{'columns'} };
-
- print "Checking uniqueness of ( ", join(', ', map "'$_'", @columns )," ) in table '$on'\n"
- if $opt{'verbose'};
-
- my ($scond, $tcond);
- if ( $scond = $tcond = $args{'condition'} ) {
- $scond =~ s/(\s|^)\./$1s./g;
- $tcond =~ s/(\s|^)\./$1t./g;
- }
-
- my $query = "SELECT s.id, t.id, ". join(', ', map "s.$_", @columns)
- ." FROM $on s LEFT JOIN $on t "
- ." ON s.id != t.id AND ". join(' AND ', map "s.$_ = t.$_", @columns)
- . ($tcond? " AND ( $tcond )": "")
- . ($args{'extra_tables'} ? join(", ", "", @{$args{'extra_tables'}}) : "")
- ." WHERE t.id IS NOT NULL "
- ." AND ". join(' AND ', map "s.$_ IS NOT NULL", @columns);
- $query .= " AND ( $scond )" if $scond;
- $query .= " AND ( $args{'extra_condition'} )" if $args{'extra_condition'};
-
- my $sth = execute_query(
- $query,
- $args{'bind_values'}? (@{ $args{'bind_values'} }, @{ $args{'bind_values'} }): (),
- $args{'extra_values'}? (@{ $args{'extra_values'} }): ()
- );
- while ( my ($sid, $tid, @set) = $sth->fetchrow_array ) {
- print STDERR "Record #$tid in $on has the same set of values as $sid\n";
- for ( my $i = 0; $i < @columns; $i++ ) {
- print STDERR "\t$columns[$i] => '$set[$i]'\n";
- }
- $args{'action'}->( $tid, map { $columns[$_] => $set[$_] } (0 .. (@columns-1)) ) if $args{'action'};
- }
-}
-
-sub load_record {
- my ($table, $id) = @_;
- my $sth = execute_query( "SELECT * FROM $table WHERE id = ?", $id );
- return $sth->fetchrow_hashref('NAME_lc');
-}
-
-sub delete_record {
- my ($table, $id) = (@_);
- print "Deleting record #$id in $table\n" if $opt{'verbose'};
- my $query = "DELETE FROM $table WHERE id = ?";
- $redo_check{ $_ } = 1 foreach @{ $redo_on{'Delete'}{ $table } || [] };
- return execute_query( $query, $id );
-}
-
-sub create_record {
- print "Creating a record in $_[0]\n" if $opt{'verbose'};
- $redo_check{ $_ } = 1 foreach @{ $redo_on{'Create'}{ $_[0] } || [] };
- return $RT::Handle->Insert( @_ );
-}
-
-sub update_records {
- my $table = shift;
- my $where = shift;
- my $what = shift;
-
- my (@where_cols, @where_binds);
- while ( my ($k, $v) = each %$where ) { push @where_cols, $k; push @where_binds, $v; }
-
- my (@what_cols, @what_binds);
- while ( my ($k, $v) = each %$what ) { push @what_cols, $k; push @what_binds, $v; }
-
- print "Updating record(s) in $table\n" if $opt{'verbose'};
- my $query = "UPDATE $table SET ". join(', ', map "$_ = ?", @what_cols)
- ." WHERE ". join(' AND ', map "$_ = ?", @where_cols);
- $redo_check{ $_ } = 1 foreach @{ $redo_on{'Update'}{ $table } || [] };
- return execute_query( $query, @what_binds, @where_binds );
-}
-
-sub execute_query {
- my ($query, @binds) = @_;
-
- print "Executing query: $query\n\n" if $opt{'verbose'};
-
- my $sth = $dbh->prepare( $query ) or die "couldn't prepare $query\n\tError: ". $dbh->errstr;
- $sth->execute( @binds ) or die "couldn't execute $query\n\tError: ". $sth->errstr;
- return $sth;
-}
-
-{ my %cached_answer;
-sub prompt {
- my $action = shift;
- my $msg = shift;
- my $token = shift || join ':', caller;
-
- return 0 unless $opt{'resolve'};
- return 1 if $opt{'force'};
-
- return $cached_answer{ $token } if exists $cached_answer{ $token };
-
- print $msg, "\n";
- print "$action ALL records with the same defect? [N]: ";
- my $a = <STDIN>;
- return $cached_answer{ $token } = 1 if $a =~ /^(y|yes)$/i;
- return $cached_answer{ $token } = 0;
-} }
-
-{ my %cached_answer;
-sub prompt_action {
- my $actions = shift;
- my $msg = shift;
- my $token = shift || join ':', caller;
-
- return '' unless $opt{'resolve'};
- return lc substr $actions->[0], 0, 1 if $opt{'force'};
- return $cached_answer{ $token } if exists $cached_answer{ $token };
-
- print $msg, "\n";
- print join( ' or ', @$actions ) ." ALL records with the same defect? [do nothing]: ";
- my $a = <STDIN>;
- chomp $a;
- return $cached_answer{ $token } = '' unless $a;
- foreach ( grep rindex(lc $_, lc $a, 0) == 0, @$actions ) {
- return $cached_answer{ $token } = lc substr $a, 0, 1;
- }
- return $cached_answer{ $token } = '';
-} }
-
-{ my %cached_answer;
-sub prompt_integer {
- my $action = shift;
- my $msg = shift;
- my $token = shift || join ':', caller;
-
- return 0 unless $opt{'resolve'};
- return 0 if $opt{'force'};
-
- return $cached_answer{ $token } if exists $cached_answer{ $token };
-
- print $msg, "\n";
- print "$action ALL records with the same defect? [0]: ";
- my $a = <STDIN>; chomp $a; $a = int($a);
- return $cached_answer{ $token } = $a;
-} }
-
-1;
-
-__END__
-
-=head1 NAME
-
-rt-validator - check and correct validity of records in RT's database
-
-=head1 SYNOPSIS
-
- rt-validator --check
- rt-validator --check --verbose
- rt-validator --check --verbose --resolve
- rt-validator --check --verbose --resolve --force
-
-=head1 DESCRIPTION
-
-This script checks integrity of records in RT's DB. May delete some invalid
-records or ressurect accidentally deleted.
-
-=head1 OPTIONS
-
-=over
-
-=item check
-
- mandatory.
-
- it's equal to -c
-
-=item verbose
-
- print additional info to STDOUT
- it's equal to -v
-
-=item resolve
-
- enable resolver that can delete or create some records
-
-=item force
-
- resolve without asking questions
-
-=back
-
+++ /dev/null
-#!/usr/bin/perl -w
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-# <sales@bestpractical.com>
-#
-# (Except where explicitly superseded by other copyright notices)
-#
-#
-# LICENSE:
-#
-# This work is made available to you under the terms of Version 2 of
-# the GNU General Public License. A copy of that license should have
-# been provided with this software, but in any event can be snarfed
-# from www.gnu.org.
-#
-# This work is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-# General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-# 02110-1301 or visit their web page on the internet at
-# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-#
-#
-# CONTRIBUTION SUBMISSION POLICY:
-#
-# (The following paragraph is not intended to limit the rights granted
-# to you to modify and distribute this software under the terms of
-# the GNU General Public License and is only of importance to you if
-# you choose to contribute your changes and enhancements to the
-# community by submitting them to Best Practical Solutions, LLC.)
-#
-# By intentionally submitting any modifications, corrections or
-# derivatives to this work, or any other work intended for use with
-# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-# you are the copyright holder for those contributions and you grant
-# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-# royalty-free, perpetual, license to use, copy, create derivative
-# works based on those contributions, and sublicense and distribute
-# those contributions and any derivatives thereof.
-#
-# END BPS TAGGED BLOCK }}}
-use warnings;
-use strict;
-
-# fix lib paths, some may be relative
-BEGIN {
- die <<EOT if ${^TAINT};
-RT does not run under Perl's "taint mode". Remove -T from the command
-line, or remove the PerlTaintCheck parameter from your mod_perl
-configuration.
-EOT
-
- require File::Spec;
- my @libs = ("/opt/rt3/lib", "/opt/rt3/local/lib");
- my $bin_path;
-
- for my $lib (@libs) {
- unless ( File::Spec->file_name_is_absolute($lib) ) {
- unless ($bin_path) {
- if ( File::Spec->file_name_is_absolute(__FILE__) ) {
- $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
- }
- else {
- require FindBin;
- no warnings "once";
- $bin_path = $FindBin::Bin;
- }
- }
- $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
- }
- unshift @INC, $lib;
- }
-
-}
-
-use Getopt::Long;
-no warnings 'once';
-
-if (grep { m/help/ } @ARGV) {
- require Pod::Usage;
- print Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
-}
-
-require RT;
-RT->LoadConfig();
-RT->InitPluginPaths();
-RT->InitLogging();
-require Module::Refresh if RT->Config->Get('DevelMode');
-
-require RT::Handle;
-my ($integrity, $state, $msg) = RT::Handle->CheckIntegrity;
-
-unless ( $integrity ) {
- print STDERR <<EOF;
-
-RT couldn't connect to the database where tickets are stored.
-If this is a new installation of RT, you should visit the URL below
-to configure RT and initialize your database.
-
-If this is an existing RT installation, this may indicate a database
-connectivity problem.
-
-The error RT got back when trying to connect to your database was:
-
-$msg
-
-EOF
-
- require RT::Installer;
- # don't enter install mode if the file exists but is unwritable
- if (-e RT::Installer->ConfigFile && !-w _) {
- die 'Since your configuration exists ('
- . RT::Installer->ConfigFile
- . ") but is not writable, I'm refusing to do anything.\n";
- }
-
- RT->Config->Set( 'LexiconLanguages' => '*' );
- RT::I18N->Init;
-
- RT->InstallMode(1);
-} else {
- RT->Init( Heavy => 1 );
-
- my ($status, $msg) = RT::Handle->CheckCompatibility( $RT::Handle->dbh, 'post');
- unless ( $status ) {
- print STDERR $msg, "\n\n";
- exit -1;
- }
-}
-
-# we must disconnect DB before fork
-if ($RT::Handle) {
- $RT::Handle->dbh->disconnect if $RT::Handle->dbh;
- $RT::Handle->dbh(undef);
- undef $RT::Handle;
-}
-
-require RT::Interface::Web::Handler;
-my $app = RT::Interface::Web::Handler->PSGIApp;
-
-if ($ENV{RT_TESTING}) {
- my $screen_logger = $RT::Logger->remove('screen');
- require Log::Dispatch::Perl;
- $RT::Logger->add(
- Log::Dispatch::Perl->new(
- name => 'rttest',
- min_level => $screen_logger->min_level,
- action => {
- error => 'warn',
- critical => 'warn'
- }
- )
- );
- require Plack::Middleware::Test::StashWarnings;
- $app = Plack::Middleware::Test::StashWarnings->wrap($app);
-}
-
-# when used as a psgi file
-if (caller) {
- return $app;
-}
-
-
-# load appropriate server
-
-require Plack::Runner;
-
-my $is_fastcgi = $0 =~ m/fcgi$/;
-my $r = Plack::Runner->new( $0 =~ /standalone/ ? ( server => 'Standalone' ) :
- $is_fastcgi ? ( server => 'FCGI' )
- : (),
- env => 'deployment' );
-
-# figure out the port
-my $port;
-
-# handle "rt-server 8888" for back-compat, but complain about it
-if ($ARGV[0] && $ARGV[0] =~ m/^\d+$/) {
- warn "Deprecated: please run $0 --port $ARGV[0] instead\n";
- unshift @ARGV, '--port';
-}
-
-my @args = @ARGV;
-
-use List::MoreUtils 'last_index';
-my $last_index = last_index { $_ eq '--port' } @args;
-
-my $explicit_port;
-
-if ( $last_index != -1 && $args[$last_index+1] =~ /^\d+$/ ) {
- $explicit_port = $args[$last_index+1];
- $port = $explicit_port;
-
- # inform the rest of the system what port we manually chose
- my $old_app = $app;
- $app = sub {
- my $env = shift;
-
- $env->{'rt.explicit_port'} = $port;
-
- $old_app->($env, @_);
- };
-}
-else {
- # default to the configured WebPort and inform Plack::Runner
- $port = RT->Config->Get('WebPort') || '8080';
- push @args, '--port', $port;
-}
-
-push @args, '--server', 'Standalone' if RT->InstallMode;
-push @args, '--server', 'Starlet' unless $r->{server} || grep { m/--server/ } @args;
-
-$r->parse_options(@args);
-
-delete $r->{options} if $is_fastcgi; ### mangle_host_port_socket ruins everything
-
-unless ($r->{env} eq 'development') {
- push @{$r->{options}}, server_ready => sub {
- my($args) = @_;
- my $name = $args->{server_software} || ref($args); # $args is $server
- my $host = $args->{host} || 0;
- my $proto = $args->{proto} || 'http';
- print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
- };
-}
-eval { $r->run($app) };
-if (my $err = $@) {
- handle_startup_error($err);
-}
-
-exit 0;
-
-sub handle_startup_error {
- my $err = shift;
- if ( $err =~ /listen/ ) {
- handle_bind_error();
- } else {
- die
- "Something went wrong while trying to run RT's standalone web server:\n\t"
- . $err;
- }
-}
-
-
-sub handle_bind_error {
-
- print STDERR <<EOF;
-WARNING: RT couldn't start up a web server on port @{[$port]}.
-This is often the case if the port is already in use or you're running @{[$0]}
-as someone other than your system's "root" user. You may also specify a
-temporary port with: $0 --port <port>
-EOF
-
- if ($explicit_port) {
- print STDERR
- "Please check your system configuration or choose another port\n\n";
- }
-}
-
-__END__
-
-=head1 NAME
-
-rt-server - RT standalone server
-
-=head1 SYNOPSIS
-
- # runs prefork server listening on port 8080, requires Starlet
- rt-server --port 8080
-
- # runs server listening on port 8080
- rt-server --server Standalone --port 8080
- # or
- standalone_httpd --port 8080
-
- # runs other PSGI server on port 8080
- rt-server --server Starman --port 8080
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-<& /Admin/Elements/Header, Title => $title &>
-<& /Elements/Tabs &>
-
-<& /Elements/ListActions, actions => \@results &>
-
-<form action="<%RT->Config->Get('WebPath')%>/Admin/Users/Modify.html" method="post" enctype="multipart/form-data">
-%if ($Create) {
-<input type="hidden" class="hidden" name="id" value="new" />
-% } else {
-<input type="hidden" class="hidden" name="id" value="<%$UserObj->Id%>" />
-% }
-<table width="100%" border="0">
-<tr>
-
-<td valign="top" class="boxcontainer">
-<&| /Widgets/TitleBox, title => loc('Identity') &>
-
-<table>
-<tr><td align="right">
-<&|/l&>Username</&>:
-</td><td>
-<input name="Name" value="<%$UserObj->Name||$Name||''%>" /> <strong><&|/l&>(required)</&></strong>
-</td></tr>
-<tr><td align="right">
-<&|/l&>Email</&>:
-</td><td>
-<input name="EmailAddress" value="<%$UserObj->EmailAddress||$EmailAddress||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Real Name</&>:
-</td><td>
-<input name="RealName" value="<%$UserObj->RealName||$RealName||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Nickname</&>:
-</td><td>
-<input name="NickName" value="<%$UserObj->NickName||$NickName||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Unix login</&>:
-</td><td>
-<input name="Gecos" value="<%$UserObj->Gecos||$Gecos||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Language</&>:
-</td><td>
-<& /Elements/SelectLang, Name => 'Lang', Default => $UserObj->Lang||$Lang &>
-</td></tr>
-<tr><td align="right">
-<&|/l&>Extra info</&>:
-</td><td>
-<textarea name="FreeformContactInfo" cols="20" rows="5"><%$UserObj->FreeformContactInfo||$FreeformContactInfo||''%></textarea>
-</td></tr>
-</table>
-</&>
-<br />
-
-<&| /Widgets/TitleBox, title => loc('Customers') &>
-<& /Elements/EditCustomers, Object => $UserObj, CustomerString=> $CustomerString, ServiceString => $ServiceString &>
-</&>
-<br />
-
-<&| /Widgets/TitleBox, title => loc('Access control') &>
-<input type="hidden" class="hidden" name="SetEnabled" value="1" />
-<input type="checkbox" class="checkbox" name="Enabled" value="1" <%$EnabledChecked%> />
-<&|/l&>Let this user access RT</&><br />
-
-
-<input type="hidden" class="hidden" name="SetPrivileged" value="1" />
-<input type="checkbox" class="checkbox" name="Privileged" value="1" <%$PrivilegedChecked||''%> /> <&|/l&>Let this user be granted rights</&> (<&|/l&>Privileged</&>)<br />
-
-<& /Elements/EditPassword,
- User => $UserObj,
- Name => [qw(CurrentPass Pass1 Pass2)],
-&>
-</&>
-% $m->callback( %ARGS, CallbackName => 'LeftColumnBottom', UserObj => $UserObj );
-</td>
-
-<td valign="top" class="boxcontainer">
-<&| /Widgets/TitleBox, title => loc('Location') &>
-<table>
-<tr><td align="right">
-<&|/l&>Organization</&>:
-</td><td>
-<input name="Organization" value="<%$UserObj->Organization||$Organization||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Address1</&>:
-</td><td>
-<input name="Address1" value="<%$UserObj->Address1||$Address1||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Address2</&>:
-</td><td>
-<input name="Address2" value="<%$UserObj->Address2||$Address2||''%>" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>City</&>:
-</td><td>
-<input name="City" value="<%$UserObj->City||$City||''%>" size="14" />
-
-</td></tr>
-<tr><td align="right">
-<&|/l&>State</&>:
-</td><td>
-<input name="State" value="<%$UserObj->State||$State||''%>" size="3" />
-
-</td></tr>
-<tr><td align="right">
-<&|/l&>Zip</&>:
-</td><td>
-<input name="Zip" value="<%$UserObj->Zip||$Zip||''%>" size="9" />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Country</&>:
-</td><td>
-<input name="Country" value="<%$UserObj->Country||$Country||''%>" />
-</td></tr>
-</table>
-</&>
-<br />
-<&| /Widgets/TitleBox, title => loc('Phone numbers') &>
-<table>
-<tr><td align="right">
-<&|/l&>Residence</&>:
-</td><td>
-<input name="HomePhone" value="<%$UserObj->HomePhone||$HomePhone||''%>" size="13" /><br />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Work</&>:
-</td><td>
-<input name="WorkPhone" value="<%$UserObj->WorkPhone||$WorkPhone||''%>" size="13" /><br />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Mobile</&>:
-</td><td>
-<input name="MobilePhone" value="<%$UserObj->MobilePhone||$MobilePhone||''%>" size="13" /><br />
-</td></tr>
-<tr><td align="right">
-<&|/l&>Pager</&>:
-</td><td>
-<input name="PagerPhone" value="<%$UserObj->PagerPhone||$PagerPhone||''%>" size="13" /><br />
-</td>
-</tr>
-</table>
-</&>
-<br />
-<&| /Widgets/TitleBox, title => loc('Custom Fields') &>
-<table>
-% my $CFs = $UserObj->CustomFields;
-% while (my $CF = $CFs->Next) {
-<tr valign="top"><td align="right">
-<% loc($CF->Name) %>:
-</td><td>
-% if ($UserObj->id) {
-<& /Elements/EditCustomField, %ARGS, Object => $UserObj, CustomField => $CF &>
-% } else {
-<& /Elements/EditCustomField, %ARGS, NamePrefix => 'Object-RT::User--CustomField-', CustomField => $CF &>
-% }
-</td></tr>
-% }
-</table>
-</&>
-% $m->callback( %ARGS, CallbackName => 'RightColumnBottom', UserObj => $UserObj );
-</td></tr>
-<tr>
-<td colspan="2">
-<&| /Widgets/TitleBox, title => loc('Comments about this user') &>
-<textarea class="comments" name="Comments" cols="80" rows="5" wrap="virtual"><%$UserObj->Comments||$Comments||''%></textarea>
-</&>
-%if (!$Create && $UserObj->Privileged) {
-<br />
-<&| /Widgets/TitleBox, title => loc('Signature') &>
-<textarea class="signature" cols="80" rows="5" name="Signature" wrap="hard"><%$UserObj->Signature||$Signature||''%></textarea>
-</&>
-% }
-
-</td>
-</tr>
-</table>
-
-% if ( $Create ) {
-<& /Elements/Submit, Label => loc('Create') &>
-% } else {
-<& /Elements/Submit, Label => loc('Save Changes') &>
-% }
-</form>
-
-<%INIT>
-
-my $UserObj = RT::User->new($session{'CurrentUser'});
-my ($title, $PrivilegedChecked, $EnabledChecked, $Disabled, $result, @results);
-
-my ($val, $msg);
-
-if ($Create) {
- $title = loc("Create a new user");
-}
-else {
-
- if ( defined $id && $id eq 'new') {
- ( $val, $msg ) = $UserObj->Create(
- Name => $Name,
- EmailAddress => $ARGS{'EmailAddress'},
- Name => $ARGS{'Name'},
- Comments => $ARGS{'Comments'},
- Signature => $ARGS{'Signature'},
- EmailAddress => $ARGS{'EmailAddress'},
- FreeformContactInfo => $ARGS{'FreeformContactInfo'},
- Organization => $ARGS{'Organization'},
- RealName => $ARGS{'RealName'},
- NickName => $ARGS{'NickName'},
- Lang => $ARGS{'Lang'},
- EmailEncoding => $ARGS{'EmailEncoding'},
- WebEncoding => $ARGS{'WebEncoding'},
- ExternalContactInfoId => $ARGS{'ExternalContactInfoId'},
- ContactInfoSystem => $ARGS{'ContactInfoSystem'},
- Gecos => $ARGS{'Gecos'},
- ExternalAuthId => $ARGS{'ExternalAuthId'},
- AuthSystem => $ARGS{'AuthSystem'},
- HomePhone => $ARGS{'HomePhone'},
- WorkPhone => $ARGS{'WorkPhone'},
- MobilePhone => $ARGS{'MobilePhone'},
- PagerPhone => $ARGS{'PagerPhone'},
- Address1 => $ARGS{'Address1'},
- Address2 => $ARGS{'Address2'},
- City => $ARGS{'City'},
- State => $ARGS{'State'},
- Zip => $ARGS{'Zip'},
- Country => $ARGS{'Country'},
- Privileged => $ARGS{'Privileged'},
- Disabled => ($ARGS{'Enabled'} ? 0 : 1)
- );
-
- if ($val) {
- push @results, $msg;
- push @results, ProcessObjectCustomFieldUpdates( ARGSRef => \%ARGS, Object => $UserObj );
- } else {
- push @results, loc('User could not be created: [_1]', $msg);
- }
- } else {
- $UserObj->Load($id) || $UserObj->Load($Name)
- || Abort("Couldn't load user '" . ( $Name || '') . "'");
- $val = $UserObj->Id();
- }
-
- if ($val) {
- $title = loc("Modify the user [_1]", $UserObj->Name);
- }
-
- # If the create failed
- else {
- $title = loc("Create a new user");
- $Create = 1;
- }
-}
-
-
-$m->callback( %ARGS, CallbackName => 'BeforeUpdate', User => $UserObj, ARGSRef => \%ARGS, Results => \@results );
-
-
-# If we have a user to modify, lets try.
-if ($UserObj->Id && $id ne 'new') {
-
- my @fields = qw(Name Comments Signature EmailAddress FreeformContactInfo
- Organization RealName NickName Lang EmailEncoding WebEncoding
- ExternalContactInfoId ContactInfoSystem Gecos ExternalAuthId
- AuthSystem HomePhone WorkPhone MobilePhone PagerPhone Address1
- Address2 City State Zip Country
- );
-
- my @fieldresults = UpdateRecordObject ( AttributesRef => \@fields,
- Object => $UserObj,
- ARGSRef => \%ARGS );
- push (@results,@fieldresults);
- push @results, ProcessObjectCustomFieldUpdates( ARGSRef => \%ARGS, Object => $UserObj );
-
- #deal with freeside customer links
- push @results, ProcessObjectCustomers( ARGSRef => \%ARGS, Object => $UserObj );
-
- # {{{ Deal with special fields: Privileged, Enabled
- if ( $SetPrivileged and $Privileged != $UserObj->Privileged ) {
- my ($code, $msg) = $UserObj->SetPrivileged($Privileged);
- push @results, loc('Privileged status: [_1]', loc_fuzzy($msg));
- }
-
- #we're asking about enabled on the web page but really care about disabled.
- $Disabled = $Enabled ? 0 : 1;
-
- if ( ($SetEnabled) and ( $Disabled != $UserObj->Disabled) ) {
- my ($code, $msg) = $UserObj->SetDisabled($Disabled);
- push @results, $msg;
- }
-
-
-}
-
-
-my %password_cond = $UserObj->CurrentUserRequireToSetPassword;
-if ( $UserObj->Id ) {
- # Deal with Password field
- my ($status, $msg) = $UserObj->SafeSetPassword(
- Current => $CurrentPass,
- New => $Pass1,
- Confirmation => $Pass2,
- );
- push @results, $msg;
-
- if ( $id eq 'new' && !$status ) {
- push @results, loc("A password was not set, so user won't be able to login.");
- }
-}
-
-
-# Do some setup for the ui
-unless ( $UserObj->id && $UserObj->Disabled ) {
- $EnabledChecked = 'checked="checked"';
-}
-
-if ((!$Create && $UserObj->Privileged()) or (!$UserObj->Id and $Privileged)) {
- $PrivilegedChecked = 'checked="checked"';
-}
-
-# This code does automatic redirection if any updates happen.
-MaybeRedirectForResults(
- Actions => \@results,
- Arguments => { id => $UserObj->Id },
-) if $UserObj->Id;
-
-</%INIT>
-
-
-<%ARGS>
-$id => undef
-$Name => undef
-$Comments => undef
-$Signature => undef
-$EmailAddress => undef
-$FreeformContactInfo => undef
-$Organization => undef
-$RealName => undef
-$NickName => undef
-$Privileged => undef
-$SetPrivileged => undef
-$Enabled => undef
-$SetEnabled => undef
-$Lang => undef
-$EmailEncoding => undef
-$WebEncoding => undef
-$ExternalContactInfoId => undef
-$ContactInfoSystem => undef
-$Gecos => undef
-$ExternalAuthId => undef
-$AuthSystem => undef
-$HomePhone => undef
-$WorkPhone => undef
-$MobilePhone => undef
-$PagerPhone => undef
-$Address1 => undef
-$Address2 => undef
-$City => undef
-$State => undef
-$Zip => undef
-$Country => undef
-$CurrentPass => undef
-$Pass1 => undef
-$Pass2 => undef
-$Create=> undef
-$OnlySearchForCustomers => undef
-$OnlySearchForServices => undef
-$CustomerString => undef
-$ServiceString => undef
-</%ARGS>
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-<& /Elements/Header, Title => $title &>
-<& /Elements/Tabs &>
-
-<& /Elements/ListActions, actions => \@results &>
-<form method="post" action="<% RT->Config->Get('WebPath') %>/Search/Bulk.html" enctype="multipart/form-data" name="BulkUpdate" id="BulkUpdate">
-% foreach my $var (qw(Query Format OrderBy Order Rows Page SavedChartSearchId)) {
-<input type="hidden" class="hidden" name="<%$var%>" value="<%$ARGS{$var} || ''%>" />
-%}
-<& /Elements/CollectionList,
- Query => $Query,
- DisplayFormat => $Format,
- Format => $ARGS{'Format'},
- Verbatim => 1,
- AllowSorting => 1,
- OrderBy => $OrderBy,
- Order => $Order,
- Rows => $Rows,
- Page => $Page,
- BaseURL => RT->Config->Get('WebPath')."/Search/Bulk.html?",
- Class => 'RT::Tickets'
- &>
-
-% $m->callback(CallbackName => 'AfterTicketList', ARGSRef => \%ARGS);
-
-<hr />
-
-<& /Elements/Submit, Label => loc('Update'), CheckboxNameRegex => '/^UpdateTicket\d+$/', CheckAll => 1, ClearAll => 1 &>
-<br />
-<&|/Widgets/TitleBox, title => $title &>
-<table>
-<tr>
-<td valign="top">
-<table>
-<tr><td class="label"> <&|/l&>Make Owner</&>: </td>
-<td class="value"> <& /Elements/SelectOwner, Name => "Owner", Default => $ARGS{Owner} || '' &>
-(<input type="checkbox" class="checkbox" name="ForceOwnerChange"
- <% $ARGS{ForceOwnerChange} ? 'checked="checked"' : '' %> /> <&|/l&>Force change</&>) </td></tr>
-<tr><td class="label"> <&|/l&>Add Requestor</&>: </td>
-<td class="value"> <input name="AddRequestor" size="20" value="<% $ARGS{AddRequestor} || '' %>" /> </td></tr>
-<tr><td class="label"> <&|/l&>Remove Requestor</&>: </td>
-<td class="value"> <input name="DeleteRequestor" size="20" value="<% $ARGS{DeleteRequestor} || '' %>"/> </td></tr>
-<tr><td class="label"> <&|/l&>Add Cc</&>: </td>
-<td class="value"> <input name="AddCc" size="20" value="<% $ARGS{AddCc} || '' %>" /> </td></tr>
-<tr><td class="label"> <&|/l&>Remove Cc</&>: </td>
-<td class="value"> <input name="DeleteCc" size="20" value="<% $ARGS{DeleteCc} || '' %>" /> </td></tr>
-<tr><td class="label"> <&|/l&>Add AdminCc</&>: </td>
-<td class="value"> <input name="AddAdminCc" size="20" value="<% $ARGS{AddAdminCc} || '' %>" /> </td></tr>
-<tr><td class="label"> <&|/l&>Remove AdminCc</&>: </td>
-<td class="value"> <input name="DeleteAdminCc" size="20" value="<% $ARGS{DeleteAdminCc} || '' %>" /> </td></tr>
-</table>
-</td>
-<td valign="top">
-<table>
-<tr><td class="label"> <&|/l&>Make subject</&>: </td>
-<td class="value"> <input name="Subject" size="20" value="<% $ARGS{Subject} || '' %>"/> </td></tr>
-<tr><td class="label"> <&|/l&>Make priority</&>: </td>
-% my $rel = ($ARGS{Priority} =~ s/^R//);
-<td class="value"> <& /Elements/SelectPriority, Name => "Priority", Default => $ARGS{Priority} &>
-<select name="Priority-Mode">
-<option value="absolute" <% !$rel && 'selected' %>>absolute</option>
-<option value="relative" <% $rel && 'selected' %>>relative</option>
-</select>
-</td></tr>
-<tr><td class="label"> <&|/l&>Make queue</&>: </td>
-<td class="value"> <& /Elements/SelectQueue, Name => "Queue", Default => $ARGS{Queue} &> </td></tr>
-<tr><td class="label"> <&|/l&>Make Status</&>: </td>
-<td class="value"> <& /Elements/SelectStatus, Name => "Status", Default => $ARGS{Status}, Queues => $seen_queues &> </td></tr>
-<tr><td class="label"> <&|/l&>Make date Starts</&>: </td>
-<td class="value"> <& /Elements/SelectDate, Name => "Starts_Date", Default => $ARGS{Starts_Date} || '' &> </td></tr>
-<tr><td class="label"> <&|/l&>Make date Started</&>: </td>
-<td class="value"> <& /Elements/SelectDate, Name => "Started_Date", Default => $ARGS{Started_Date} || '' &> </td></tr>
-<tr><td class="label"> <&|/l&>Make date Told</&>: </td>
-<td class="value"> <& /Elements/SelectDate, Name => "Told_Date", Default => $ARGS{Told_Date} || '' &> </td></tr>
-<tr><td class="label"> <&|/l&>Make date Due</&>: </td>
-<td class="value"> <& /Elements/SelectDate, Name => "Due_Date", Default => $ARGS{Due_Date} || '' &> </td></tr>
-<tr><td class="label"> <&|/l&>Make date Resolved</&>: </td>
-<td class="value"> <& /Elements/SelectDate, Name => "Resolved_Date", Default => $ARGS{Resolved_Date} || '' &> </td></tr>
-</table>
-
-</td>
-</tr>
-</table>
-</&>
-<&| /Widgets/TitleBox, title => loc('Add comments or replies to selected tickets') &>
-<table>
-<tr><td align="right"><&|/l&>Update Type</&>:</td>
-<td><select name="UpdateType">
- <option value="private" <% $ARGS{UpdateType} && $ARGS{UpdateType} eq 'private' ? 'selected="selected"' : '' %> ><&|/l&>Comments (Not sent to requestors)</&></option>
-<option value="response" <% $ARGS{UpdateType} && $ARGS{UpdateType} eq 'response' ? 'selected="selected"' : '' %>><&|/l&>Reply to requestors</&></option>
-</select>
-</td></tr>
-<tr><td align="right"><&|/l&>Subject</&>:</td><td> <input name="UpdateSubject"
-size="60" value="<% $ARGS{UpdateSubject} || "" %>" /></td></tr>
-% while (my $CF = $TxnCFs->Next()) {
-<tr>
-<td align="right"><% $CF->Name %>:</td>
-<td><& /Elements/EditCustomField,
- CustomField => $CF,
- NamePrefix => "Object-RT::Transaction--CustomField-",
- Default => $ARGS{"Object-RT::Transaction--CustomField-" . $CF->id . '-Values'} ||
- $ARGS{"Object-RT::Transaction--CustomField-" . $CF->id . '-Value'},
- &><em><% $CF->FriendlyType %></em></td>
-</td></tr>
-% } # end if while
-
-<& /Ticket/Elements/AddAttachments, %ARGS &>
-
- <tr><td class="labeltop"><&|/l&>Message</&>:</td><td>
-%# Currently, bulk update always starts with Comment not Reply selected, so we check this unconditionally
-% my $IncludeSignature = RT->Config->Get('MessageBoxIncludeSignatureOnComment');
-<& /Elements/MessageBox, Name => "UpdateContent",
- $ARGS{UpdateContent} ? ( Default => $ARGS{UpdateContent}, IncludeSignature => 0 ) :
- ( IncludeSignature => $IncludeSignature ),
- &>
- </td></tr>
- </table>
-
-</&>
-
-<%perl>
-my $cfs = RT::CustomFields->new($session{'CurrentUser'});
-$cfs->LimitToGlobal();
-$cfs->LimitToQueue($_) for keys %$seen_queues;
-</%perl>
-
-% if ($cfs->Count) {
-<&|/Widgets/TitleBox, title => loc('Edit Custom Fields'), color => "#336633"&>
-<table>
-<tr>
-<th><&|/l&>Name</&></th>
-<th><&|/l&>Add values</&></th>
-<th><&|/l&>Delete values</&></th>
-</tr>
-% while (my $cf = $cfs->Next()) {
-<tr>
-<td class="label"><% loc($cf->Name) %><br />
-<em>(<%$cf->FriendlyType%>)</em></td>
-% my $rows = 5;
-% my $cf_id = $cf->id;
-% my @add = (NamePrefix => 'Bulk-Add-CustomField-', CustomField => $cf, Rows => $rows,
-% Multiple => ($cf->MaxValues ==1 ? 0 : 1) , Cols => 25,
-% Default => $ARGS{"Bulk-Add-CustomField-$cf_id-Values"} || $ARGS{"Bulk-Add-CustomField-$cf_id-Value"}, );
-% my @del = (NamePrefix => 'Bulk-Delete-CustomField-', CustomField => $cf,
-% Rows => $rows, Multiple => 1, Cols => 25,
-% Default => $ARGS{"Bulk-Delete-CustomField-$cf_id-Values"} || $ARGS{"Bulk-Delete-CustomField-$cf_id-Value"}, );
-% if ($cf->Type eq 'Select') {
-<td><& /Elements/EditCustomFieldSelect, @add &></td>
-<td><& /Elements/EditCustomFieldSelect, @del &></td>
-% } elsif ($cf->Type eq 'Combobox') {
-<td><& /Elements/EditCustomFieldCombobox, @add &></td>
-<td><& /Elements/EditCustomFieldCombobox, @del &></td>
-% } elsif ($cf->Type eq 'Freeform') {
-<td><& /Elements/EditCustomFieldFreeform, @add &></td>
-<td><& /Elements/EditCustomFieldFreeform, @del &></td>
-% } elsif ($cf->Type eq 'Text') {
-<td><& /Elements/EditCustomFieldText, @add &></td>
-<td> </td>
-% } elsif ($cf->Type eq 'Date') {
-<td><& /Elements/EditCustomFieldDate, @add, Default => undef &></td>
-<td><& /Elements/EditCustomFieldDate, @del, Default => undef &></td>
-% } elsif ($cf->Type eq 'DateTime') {
-% # Pass datemanip format to prevent another tz date conversion
-<td><& /Elements/EditCustomFieldDateTime, @add, Default => undef, Format => 'datemanip' &></td>
-<td><& /Elements/EditCustomFieldDateTime, @del, Default => undef, Format => 'datemanip' &></td>
-% } else {
-% $RT::Logger->crit("Unknown CustomField type: " . $cf->Type);
-% }
-</tr>
-% }
-</table>
-</&>
-% }
-
-<&|/Widgets/TitleBox, title => loc('Edit Links'), color => "#336633"&>
-<em><&|/l&>Enter tickets or URIs to link tickets to. Separate multiple entries with spaces.</&></em><br />
-<& /Ticket/Elements/BulkLinks, Tickets => $Tickets, $ARGS{'AddMoreAttach'} ? %ARGS : () &>
-</&>
-
-<& /Elements/Submit, Label => loc('Update') &>
-
-
-</form>
-
-
-<%INIT>
-unless ( defined $Rows ) {
- $Rows = $RowsPerPage;
- $ARGS{Rows} = $RowsPerPage;
-}
-my $title = loc("Update multiple tickets");
-
-# Iterate through the ARGS hash and remove anything with a null value.
-map ( $ARGS{$_} =~ /^$/ && ( delete $ARGS{$_} ), keys %ARGS );
-
-my (@results);
-
-ProcessAttachments(ARGSRef => \%ARGS);
-
-$Page ||= 1;
-
-$Format ||= RT->Config->Get('DefaultSearchResultFormat');
-
-# inject _CHECKBOX to the first field.
-$Format =~ s/'?([^']+)'?,/'___CHECKBOX__$1',/; #'
-
-my $Tickets = RT::Tickets->new( $session{'CurrentUser'} );
-$Tickets->FromSQL($Query);
-if ( $OrderBy =~ /\|/ ) {
-
- # Multiple Sorts
- my @OrderBy = split /\|/, $OrderBy;
- my @Order = split /\|/, $Order;
- $Tickets->OrderByCols(
- map { { FIELD => $OrderBy[$_], ORDER => $Order[$_] } }
- ( 0 .. $#OrderBy ) );
-}
-else {
- $Tickets->OrderBy( FIELD => $OrderBy, ORDER => $Order );
-}
-
-$Tickets->RowsPerPage($Rows) if ($Rows);
-$Tickets->GotoPage( $Page - 1 ); # SB uses page 0 as the first page
-
-Abort( loc("No search to operate on.") ) unless ($Tickets);
-
-# build up a list of all custom fields for tickets that we're displaying, so
-# we can display sane edit widgets.
-
-my $fields = {};
-my $seen_queues = {};
-while ( my $ticket = $Tickets->Next ) {
- next if $seen_queues->{ $ticket->Queue }++;
-
- my $custom_fields = $ticket->CustomFields;
- while ( my $field = $custom_fields->Next ) {
- $fields->{ $field->id } = $field;
- }
-}
-
-#Iterate through each ticket we've been handed
-my @linkresults;
-
-$Tickets->RedoSearch();
-
-# pull out the labels for any custom fields we want to update
-
-my $cf_del_keys;
-@$cf_del_keys = grep { /^Bulk-Delete-CustomField/ } keys %ARGS;
-my $cf_add_keys;
-@$cf_add_keys = grep { /^Bulk-Add-CustomField/ } keys %ARGS;
-
-if ( defined($ARGS{'Priority'})
- and ($ARGS{'Priority-Mode'} || '') eq 'relative' ) {
- # magic in Ticket::SetPriority
- $ARGS{'Priority'} = 'R'.$ARGS{'Priority'};
-}
-delete $ARGS{'Priority-Mode'};
-
-unless ( $ARGS{'AddMoreAttach'} ) {
- # Add session attachments if any to be processed by ProcessUpdateMessage
- $ARGS{'UpdateAttachments'} = $session{'Attachments'} if ( $session{'Attachments'} );
-
- while ( my $Ticket = $Tickets->Next ) {
- next unless ( $ARGS{ "UpdateTicket" . $Ticket->Id } );
-
- #Update the links
- $ARGS{'id'} = $Ticket->id;
-
- my @updateresults = ProcessUpdateMessage(
- TicketObj => $Ticket,
- ARGSRef => \%ARGS,
- );
-
- #Update the basics.
- my @basicresults =
- ProcessTicketBasics( TicketObj => $Ticket, ARGSRef => \%ARGS );
- my @dateresults =
- ProcessTicketDates( TicketObj => $Ticket, ARGSRef => \%ARGS );
-
- #Update the watchers
- my @watchresults =
- ProcessTicketWatchers( TicketObj => $Ticket, ARGSRef => \%ARGS );
-
- foreach my $type (qw(MergeInto DependsOn MemberOf RefersTo)) {
- $ARGS{ $Ticket->id . "-" . $type } = $ARGS{"Ticket-$type"};
- $ARGS{ $type . "-" . $Ticket->id } = $ARGS{"$type-Ticket"};
- }
- @linkresults =
- ProcessTicketLinks( TicketObj => $Ticket, ARGSRef => \%ARGS );
- foreach my $type (qw(MergeInto DependsOn MemberOf RefersTo)) {
- delete $ARGS{ $type . "-" . $Ticket->id };
- delete $ARGS{ $Ticket->id . "-" . $type };
- }
-
- my @cfresults;
-
- foreach my $list ( $cf_add_keys, $cf_del_keys ) {
- next unless $list->[0];
-
-
- my $op;
- if ( $list->[0] =~ /Add/ ) {
- $op = 'add';
-
- }
- elsif ( $list->[0] =~ /Del/ ) {
- $op = 'del';
- }
- else {
- $RT::Logger->crit(
- "Got an op that was neither add nor delete. can never happen"
- . $list->[0] );
- last;
- }
-
- foreach my $key (@$list) {
- my ( $cfid, $cf );
- next if $key =~ /CustomField-(\d+)-Category$/;
- if ( $key =~ /CustomField-(\d+)-/ ) {
- $cfid = $1;
- $cf = RT::CustomField->new( $session{'CurrentUser'} );
- $cf->Load($cfid);
- }
- else {next}
- my @values =
- ref( $ARGS{$key} ) eq 'ARRAY'
- ? @{ $ARGS{$key} }
- : ( $ARGS{$key} );
- map { s/(\r\n|\r)/\n/g; } @values; # fix the newlines
- # now break the multiline values into multivalues
- @values = map { split( /\n/, $_ ) } @values
- unless ( $cf->SingleValue );
-
- my $current_values = $Ticket->CustomFieldValues($cfid);
-
- if ( $cf->Type eq 'DateTime' || $cf->Type eq 'Date' ){
- # Clear out empty string submissions to avoid
- # Not set changed to Not set
- @values = grep length, @values;
- }
-
- foreach my $value (@values) {
-
- # Convert for timezone. Without converstion,
- # HasEntry and DeleteCustomFieldValue fail because
- # the value in the DB is converted.
- if ( $op eq 'del'
- && ($cf->Type eq 'DateTime' || $cf->Type eq 'Date') ){
- my $DateObj = RT::Date->new( $session{'CurrentUser'} );
- $DateObj->Set( Format => 'unknown',
- Value => $value );
- $value = $cf->Type eq 'DateTime' ? $DateObj->ISO
- : $DateObj->ISO(Time => 0, Seconds => 0);
- }
-
- if ( $op eq 'del' && $current_values->HasEntry($value) ) {
- my ( $id, $msg ) = $Ticket->DeleteCustomFieldValue(
- Field => $cfid,
- Value => $value
- );
- push @cfresults, $msg;
- }
-
- elsif ( $op eq 'add' && !$current_values->HasEntry($value) ) {
- my ( $id, $msg ) = $Ticket->AddCustomFieldValue(
- Field => $cfid,
- Value => $value
- );
- push @cfresults, $msg;
- }
- }
- }
- }
- my @statusresults =
- ProcessTicketStatus( TicketObj => $Ticket, ARGSRef => \%ARGS );
-
- my @tempresults = (
- @watchresults, @basicresults, @dateresults,
- @updateresults, @linkresults, @cfresults,
- @statusresults
- );
-
- @tempresults =
- map {
- $_ =~ /^Ticket \d+:/ ? $_ :
- loc( "Ticket [_1]: [_2]", $Ticket->Id, $_ )
- } @tempresults;
-
- @results = ( @results, @tempresults );
- }
-
- # Cleanup WebUI
- delete $session{'Attachments'};
-
- $Tickets->RedoSearch();
-}
-
-my $TxnCFs = RT::CustomFields->new( $session{CurrentUser} );
-$TxnCFs->LimitToLookupType( RT::Transaction->CustomFieldLookupType );
-$TxnCFs->LimitToGlobalOrObjectId( keys %$seen_queues );
-
-</%INIT>
-<%args>
-$Format => undef
-$Page => 1
-$Rows => undef
-$RowsPerPage => undef
-$Order => 'ASC'
-$OrderBy => 'id'
-$Query => undef
-$SavedSearchId => undef
-$SavedChartSearchId => undef
-</%args>
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-<%ARGS>
-$Format => undef
-$Query => ''
-$OrderBy => 'id'
-$Order => 'ASC'
-$PreserveNewLines => 0
-</%ARGS>
-<%INIT>
-
-$r->content_type('text/tab-separated-values');
-$r->header_out('Content-Disposition' => 'attachment;filename="Results.tsv"');
-
-my $DisplayFormat = $m->comp('/Elements/ScrubHTML', Content => $Format);
-
-my @Format = $m->comp('/Elements/CollectionAsTable/ParseFormat', Format => $DisplayFormat);
-
-my @columns;
-
-my $should_loc = { map { $_ => 1 } qw(Status) };
-
-my $col_entry = sub {
- my $col = shift;
- # in tsv output, "#" is often a comment character but we use it for "id"
- delete $col->{title}
- if $col->{title} and $col->{title} =~ /^\s*#\s*$/;
- return {
- header => Encode::encode_utf8(loc($col->{title} || $col->{attribute})),
- map => $m->comp(
- "/Elements/ColumnMap",
- Name => $col->{attribute},
- Attr => 'value'
- ),
- should_loc => $should_loc->{$col->{attribute}},
- }
-};
-
-if ($PreserveNewLines) {
- my $col = [];
- push @columns, $col;
- for (@Format) {
- if ($_->{title} eq 'NEWLINE') {
- $col = [];
- push @columns, $col;
- }
- else {
- push @$col, $col_entry->($_);
- }
- }
-}
-else {
- push @columns, [map { $_->{attribute}
- ? $col_entry->($_)
- : () } @Format];
-}
-
-for (@columns) {
- $m->out(join("\t", map { $_->{header} } @$_)."\n");
-}
-
-my $Tickets = RT::Tickets->new( $session{'CurrentUser'} );
-$Tickets->FromSQL( $Query );
-if ( $OrderBy =~ /\|/ ) {
- # Multiple Sorts
- my @OrderBy = split /\|/, $OrderBy;
- my @Order = split /\|/, $Order;
- $Tickets->OrderByCols(
- map { { FIELD => $OrderBy[$_], ORDER => $Order[$_] } }
- ( 0 .. $#OrderBy )
- );
-}
-else {
- $Tickets->OrderBy( FIELD => $OrderBy, ORDER => $Order );
-}
-
-my $ii = 0;
-while (my $row = $Tickets->Next) {
- for my $col (@columns) {
- $m->out(join("\t", map {
- my $val = ProcessColumnMapValue($_->{map}, Arguments => [$row, $ii++], Escape => 0);
- $val = loc($val) if $_->{should_loc};
- # remove tabs from all field values, they screw up the tsv
- $val = '' unless defined $val;
- $val =~ s/(?:\n|\r)//g; $val =~ s{\t}{ }g;
- Encode::encode_utf8($val);
- } @$col)."\n");
- }
-}
-$m->abort();
-
-</%INIT>
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-<& /Elements/Header,
- Title => $title,
- onload => "function () { hide('Ticket-Create-details') }" &>
-<& /Elements/Tabs &>
-
-<& /Elements/ListActions, actions => \@results &>
-
-<form action="<% RT->Config->Get('WebPath') %>/Ticket/Create.html" method="post" enctype="multipart/form-data" name="TicketCreate">
- <input type="hidden" class="hidden" name="id" value="new" />
-
-% $m->callback( CallbackName => 'FormStart', QueueObj => $QueueObj, ARGSRef => \%ARGS );
-
-% if ($gnupg_widget) {
- <& /Elements/GnuPG/SignEncryptWidget:ShowIssues, self => $gnupg_widget &>
-% }
-
-<div id="Ticket-Create-basics">
-<a name="basics"></a>
-
-<div id="ticket-create-metadata">
- <&| /Widgets/TitleBox, title => loc("Basics"), class=>'ticket-info-basics' &>
- <table width="100%" border="0">
- <& /Ticket/Elements/EditBasics,
- InTable => 1,
- fields => [
- { name => 'Queue',
- comp => '/Elements/SelectQueue',
- args => {
- Name => 'Queue',
- Default => $QueueObj->Name,
- QueueObj => $QueueObj,
- ShowNullOption => 0,
- ShowAllQueues => 0,
- OnChange => "document.getElementsByName('id')[0].value = 'refresh'; form.submit()",
- },
- },
- { name => 'Status',
- comp => '/Elements/SelectStatus',
- args => {
- Name => "Status",
- Default => $ARGS{Status} || $QueueObj->Lifecycle->DefaultOnCreate,
- DefaultValue => 0,
- SkipDeleted => 1,
- QueueObj => $QueueObj,
- },
- },
- { name => 'Owner',
- comp => '/Elements/SelectOwner',
- args => {
- Name => "Owner",
- Default => $ARGS{Owner} || RT->Nobody->Id,
- DefaultValue => 0,
- QueueObj => $QueueObj,
- },
- }
- ]
- &>
-
-% $m->callback( CallbackName => 'AfterOwner', ARGSRef => \%ARGS );
-
- <& /Ticket/Elements/EditCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &>
- <& /Ticket/Elements/EditTransactionCustomFields, %ARGS, QueueObj => $QueueObj, InTable => 1 &>
- </table>
- </&>
-% $m->callback( CallbackName => 'AfterBasics', QueueObj => $QueueObj, ARGSRef => \%ARGS );
-</div>
-
-<div id="ticket-create-message">
- <&| /Widgets/TitleBox, title => $title, class => 'messagedetails' &>
-<table border="0" cellpadding="0" cellspacing="0">
-<tr>
-<td class="label">
-<&|/l&>Requestors</&>:
-</td>
-<td class="value" colspan="5">
-<& /Elements/EmailInput, Name => 'Requestors', Size => undef, Default => exists($ARGS{Requestors}) ? $ARGS{Requestors} : $session{CurrentUser}->EmailAddress &>
-% $m->callback( CallbackName => 'AfterRequestors', QueueObj => $QueueObj, ARGSRef => \%ARGS );
-</td>
-</tr>
-<tr>
-<td class="label">
-<&|/l&>Cc</&>:
-</td>
-<td class="value" colspan="5"><& /Elements/EmailInput, Name => 'Cc', Size => undef, Default => $ARGS{Cc} &></td>
-</tr>
-
-<tr>
- <td class="label"> </td>
- <td class="comment" colspan="5">
- <i><font size="-2">
- <&|/l&>(Sends a carbon-copy of this update to a comma-delimited list of email addresses. These people <strong>will</strong> receive future updates.)</&>
- </font></i>
- </td>
-</tr>
-
-<tr>
-<td class="label">
-<&|/l&>Admin Cc</&>:
-</td>
-<td class="value" colspan="5"><& /Elements/EmailInput, Name => 'AdminCc', Size => undef, Default => $ARGS{AdminCc} &></td>
-</tr>
-
-<tr>
- <td class="label"> </td>
- <td class="comment" colspan="5">
- <i><font size="-2">
- <&|/l&>(Sends a carbon-copy of this update to a comma-delimited list of administrative email addresses. These people <strong>will</strong> receive future updates.)</&>
- </font></i>
- </td>
-</tr>
-
-<tr>
-<td class="label">
-<&|/l&>Subject</&>:
-</td>
-<td class="value" colspan="5">
-<input type="text" name="Subject" maxsize="200" value="<%$ARGS{Subject} || ''%>" />
-% $m->callback( %ARGS, CallbackName => 'AfterSubject' );
-</td>
-</tr>
-
-% if ( $gnupg_widget ) {
-<tr><td> </td><td colspan="5">
-<& /Elements/GnuPG/SignEncryptWidget, self => $gnupg_widget, QueueObj => $QueueObj &>
-</td></tr>
-% }
-
-<tr>
-<td colspan="6">
-<&|/l&>Describe the issue below</&>:<br />
-% if ( RT->Config->Get('ArticleOnTicketCreate')) {
-<& /Articles/Elements/BeforeMessageBox, %ARGS, QueueObj => $QueueObj &>
-% }
-% $m->callback( %ARGS, QueueObj => $QueueObj, CallbackName => 'BeforeMessageBox' );
-% if (exists $ARGS{Content}) {
-<& /Elements/MessageBox, Default => $ARGS{Content}, IncludeSignature => 0 &>
-% } else {
-<& /Elements/MessageBox, QuoteTransaction => $QuoteTransaction &>
-%}
-% $m->callback( %ARGS, QueueObj => $QueueObj, CallbackName => 'AfterMessageBox' );
-
-<br />
-</td>
-</tr>
-
- <& /Ticket/Elements/AddAttachments, %ARGS, QueueObj => $QueueObj &>
- </table>
- </&>
- <& /Elements/Submit, Label => loc("Create"), id => 'SubmitTicket' &>
- </div>
-</div>
-
-<div id="Ticket-Create-details">
-<a name="details"></a>
-<table width="100%" border="0">
-<tr>
-<td width="50%" valign="top" class="boxcontainer">
- <div class="ticket-info-basics">
- <&| /Widgets/TitleBox, title => loc('The Basics'),
- title_class=> 'inverse',
- color => "#993333" &>
-<table border="0">
-<tr><td class="label"><&|/l&>Priority</&>:</td>
-<td><& /Elements/SelectPriority,
- Name => "InitialPriority",
- Default => $ARGS{InitialPriority} ? $ARGS{InitialPriority} : $QueueObj->InitialPriority,
-&></td></tr>
-<tr><td class="label"><&|/l&>Final Priority</&>:</td>
-<td><& /Elements/SelectPriority,
- Name => "FinalPriority",
- Default => $ARGS{FinalPriority} ? $ARGS{FinalPriority} : $QueueObj->FinalPriority,
-&></td></tr>
-<tr><td class="label"><&|/l&>Time Estimated</&>:</td>
-<td>
-<& /Elements/EditTimeValue, Name => 'TimeEstimated', Default => $ARGS{TimeEstimated} || '', InUnits => $ARGS{'TimeEstimated-TimeUnits'} &>
-
-</td></tr>
-<tr><td class="label"><&|/l&>Time Worked</&>:</td>
-<td>
-<& /Elements/EditTimeValue, Name => 'TimeWorked', Default => $ARGS{TimeWorked} || '', InUnits => $ARGS{'TimeWorked-TimeUnits'} &>
-</td></tr>
-<tr>
-<td class="label"><&|/l&>Time Left</&>:</td>
-<td>
-<& /Elements/EditTimeValue, Name => 'TimeLeft', Default => $ARGS{TimeLeft} || '', InUnits => $ARGS{'TimeLeft-TimeUnits'} &>
-</td></tr>
-</table>
-</&>
-<br />
-<div class="ticket-info-dates">
-<&|/Widgets/TitleBox, title => loc("Dates"),
- title_class=> 'inverse',
- color => "#663366" &>
-
-<table>
-<tr><td class="label"><&|/l&>Starts</&>:</td><td><& /Elements/SelectDate, Name => "Starts", Default => $ARGS{Starts} || '' &></td></tr>
-<tr><td class="label"><&|/l&>Due</&>:</td><td><& /Elements/SelectDate, Name => "Due", Default => $ARGS{Due} || '' &></td></tr>
-</table>
-</&>
-</div>
-</div>
-<br />
-</td>
-
-<td valign="top" class="boxcontainer">
-<div class="ticket-info-links">
-<&| /Widgets/TitleBox, title => loc('Links'), title_class=> 'inverse' &>
-
-<em><&|/l&>(Enter ticket ids or URLs, separated with spaces)</&></em>
-<table border="0">
-<tr><td class="label"><&|/l&>Depends on</&></td><td><input size="10" name="new-DependsOn" value="<% $ARGS{'new-DependsOn'} || '' %>" /></td></tr>
-<tr><td class="label"><&|/l&>Depended on by</&></td><td><input size="10" name="DependsOn-new" value="<% $ARGS{'DependsOn-new'} || '' %>" /></td></tr>
-<tr><td class="label"><&|/l&>Parents</&></td><td><input size="10" name="new-MemberOf" value="<% $ARGS{'new-MemberOf'} || '' %>" /></td></tr>
-<tr><td class="label"><&|/l&>Children</&></td><td><input size="10" name="MemberOf-new" value="<% $ARGS{'MemberOf-new'} || '' %>" /></td></tr>
-<tr><td class="label"><&|/l&>Refers to</&></td><td><input size="10" name="new-RefersTo" value="<% $ARGS{'new-RefersTo'} || '' %>" /></td></tr>
-<tr><td class="label"><&|/l&>Referred to by</&></td><td><input size="10" name="RefersTo-new" value="<% $ARGS{'RefersTo-new'} || '' %>" /></td></tr>
-<tr><td class="label">Customer ID</td><td><input size="10" name="new-Customer" value="<% $ARGS{'new-Customer'} || '' %>" /></td></tr>
-
-</table>
-</&>
-</div>
-<br />
-
-</td>
-</tr>
-</table>
-<& /Elements/Submit, Label => loc("Create") &>
-</div>
-</form>
-
-<%INIT>
-$m->callback( CallbackName => "Init", ARGSRef => \%ARGS );
-my $Queue = $ARGS{Queue};
-$session{DefaultQueue} = $Queue;
-
-if ($CloneTicket) {
- my $CloneTicketObj = RT::Ticket->new( $session{CurrentUser} );
- $CloneTicketObj->Load($CloneTicket)
- or Abort( loc("Ticket could not be loaded") );
-
- my $clone = {
- Requestors => join( ',', $CloneTicketObj->RequestorAddresses ),
- Cc => join( ',', $CloneTicketObj->CcAddresses ),
- AdminCc => join( ',', $CloneTicketObj->AdminCcAddresses ),
- InitialPriority => $CloneTicketObj->Priority,
- };
-
- $clone->{$_} = $CloneTicketObj->$_()
- for qw/Owner Subject FinalPriority Status/;
- # not TimeWorked, TimeEstimated, or TimeLeft
-
- $clone->{$_} = $CloneTicketObj->$_->AsString
- for grep { $CloneTicketObj->$_->Unix }
- map { $_ . "Obj" } qw/Starts Started Due Resolved/;
-
- my $members = $CloneTicketObj->Members;
- my ( @members, @members_of, @refers, @refers_by, @depends, @depends_by );
- my $refers = $CloneTicketObj->RefersTo;
- my $get_link_value = sub {
- my ($link, $type) = @_;
- my $uri_method = $type . 'URI';
- my $local_method = 'Local' . $type;
- my $uri = $link->$uri_method;
- return if $uri->IsLocal and
- $uri->Object and
- $uri->Object->isa('RT::Ticket') and
- $uri->Object->Type eq 'reminder';
-
- return $link->$local_method || $uri->URI;
- };
- while ( my $refer = $refers->Next ) {
- my $refer_value = $get_link_value->($refer, 'Target');
- push @refers, $refer_value if defined $refer_value;
- }
- $clone->{'new-RefersTo'} = join ' ', @refers;
-
- my $refers_by = $CloneTicketObj->ReferredToBy;
- while ( my $refer_by = $refers_by->Next ) {
- my $refer_by_value = $get_link_value->($refer_by, 'Base');
- push @refers_by, $refer_by_value if defined $refer_by_value;
- }
- $clone->{'RefersTo-new'} = join ' ', @refers_by;
-
- my $cfs = $CloneTicketObj->QueueObj->TicketCustomFields();
- while ( my $cf = $cfs->Next ) {
- next if $cf->FirstAttribute('NoClone');
- my $cf_id = $cf->id;
- my $cf_values = $CloneTicketObj->CustomFieldValues( $cf->id );
- my @cf_values;
- while ( my $cf_value = $cf_values->Next ) {
- push @cf_values, $cf_value->Content;
- }
-
- if ( @cf_values > 1 && $cf->Type eq 'Select' ) {
- $clone->{"Object-RT::Ticket--CustomField-$cf_id-Value"} = \@cf_values;
- }
- else {
- $clone->{"Object-RT::Ticket--CustomField-$cf_id-Value"} = join "\n",
- @cf_values;
- }
- }
-
- # Pass customer links along (even though cloning of parent links
- # in general is disabled).
- my $customers = $CloneTicketObj->Customers;
- my @customers;
- while ( my $customer = $customers->Next ) {
- my ($custnum) = $customer->Target =~ /cust_main\/(\d+)$/;
- push @customers, $custnum if $custnum;
- }
- $clone->{'new-Customer'} = join(' ', @customers);
-
- for ( keys %$clone ) {
- $ARGS{$_} = $clone->{$_} if not defined $ARGS{$_};
- }
-
-}
-
-my @results;
-
-my $title = loc("Create a new ticket");
-
-my $QueueObj = RT::Queue->new($session{'CurrentUser'});
-$QueueObj->Load($Queue) || Abort(loc("Queue could not be loaded."));
-
-$m->callback( QueueObj => $QueueObj, title => \$title, results => \@results, ARGSRef => \%ARGS );
-
-$QueueObj->Disabled && Abort(loc("Cannot create tickets in a disabled queue."));
-
-my $CFs = $QueueObj->TicketCustomFields();
-
-my $ValidCFs = $m->comp(
- '/Elements/ValidateCustomFields',
- CustomFields => $CFs,
- ARGSRef => \%ARGS
-);
-
-ProcessAttachments(ARGSRef => \%ARGS);
-
-my $checks_failure = 0;
-
-my $gnupg_widget = $m->comp('/Elements/GnuPG/SignEncryptWidget:new', Arguments => \%ARGS );
-$m->comp( '/Elements/GnuPG/SignEncryptWidget:Process',
- self => $gnupg_widget,
- QueueObj => $QueueObj,
-);
-
-
-if ( !exists $ARGS{'AddMoreAttach'} && ($ARGS{'id'}||'') eq 'new' ) {
- my $status = $m->comp('/Elements/GnuPG/SignEncryptWidget:Check',
- self => $gnupg_widget,
- Operation => 'Create',
- QueueObj => $QueueObj,
- );
- $checks_failure = 1 unless $status;
-}
-
-# check email addresses for RT's
-{
- foreach my $field ( qw(Requestors Cc AdminCc) ) {
- my $value = $ARGS{ $field };
- next unless defined $value && length $value;
-
- my @emails = Email::Address->parse( $value );
- foreach my $email ( grep RT::EmailParser->IsRTAddress($_->address), @emails ) {
- push @results, loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email->format, loc($field =~ /^(.*?)s?$/) );
- $checks_failure = 1;
- $email = undef;
- }
- $ARGS{ $field } = join ', ', map $_->format, grep defined, @emails;
- }
-}
-
-my $skip_create = 0;
-$m->callback( CallbackName => 'BeforeCreate', ARGSRef => \%ARGS, skip_create => \$skip_create,
- checks_failure => $checks_failure, results => \@results );
-
-$m->comp( '/Articles/Elements/CheckSkipCreate', ARGSRef => \%ARGS, skip_create => \$skip_create,
- checks_failure => $checks_failure, results => \@results );
-
-if ((!exists $ARGS{'AddMoreAttach'}) and (defined($ARGS{'id'}) and $ARGS{'id'} eq 'new')) { # new ticket?
- if ( $ValidCFs && !$checks_failure && !$skip_create ) {
-# CREATE THE TICKET.
-# For some reason it's done by a Mason component named "Display.html"
-# and the call is buried in obscure error-handling stuff.
-# This comment exists to make it more visually obvious.
-# ************************************************************
-
- $m->comp('Display.html', %ARGS);
-
-# ************************************************************
-# Execution should not continue here. Display.html calls
-# Redirect() which does an $m->abort. We only get here if the
-# code dies before then, hence "$@".
- $RT::Logger->crit("After display call; error is $@");
- $m->abort();
- }
- elsif ( !$ValidCFs ) {
- # Invalid CFs
- while (my $CF = $CFs->Next) {
- my $msg = $m->notes('InvalidField-' . $CF->Id) or next;
- push @results, $CF->Name . ': ' . $msg;
- }
- }
-}
-PageMenu->child( basics => raw_html => q[<a href="#basics" onclick="return switchVisibility('Ticket-Create-basics','Ticket-Create-details');">] . loc('Basics') . q[</a>]);
-PageMenu->child( details => raw_html => q[<a href="#details" onclick="return switchVisibility('Ticket-Create-details','Ticket-Create-basics');">] . loc('Details') . q[</a>]);
-</%INIT>
-
-<%ARGS>
-$DependsOn => undef
-$DependedOnBy => undef
-$MemberOf => undef
-$QuoteTransaction => undef
-$CloneTicket => undef
-</%ARGS>
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-% $m->callback( CallbackName => 'BeforeTransactionCustomFields', TicketObj => $TicketObj, QueueObj => $QueueObj, NamePrefix => $NamePrefix );
-% if ( $WRAP ) {
-<<% $WRAP %> class="edit-transaction-custom-fields">
-% }
-% if ($CustomFields->Count) {
-% while (my $CF = $CustomFields->Next()) {
-% $CF->SetContextObject($TicketObj || $QueueObj);
-% next unless $CF->CurrentUserHasRight('ModifyCustomField');
-% next unless $CF->UILocation eq $UILocation;
-<<% $FIELD %>>
-<<% $CELL %> class="label cflabel">
- <span class="name"><% loc($CF->Name) %>:</span><br />
-% if ( $CF->Type ne 'TimeValue' ) {
- <span class="type"><% $CF->FriendlyType %></span>
-% }
-</<% $CELL %>>
-<<% $CELL %>>
-<& /Elements/EditCustomField,
- CustomField => $CF,
- NamePrefix => $NamePrefix
-&>
-% if (my $msg = $m->notes('InvalidField-' . $CF->Id)) {
- <br />
- <span class="cfinvalidfield"><% $msg %></span>
-% }
-</<% $CELL %>>
-</<% $FIELD %>>
-% }
-% }
-% if ( $WRAP ) {
-</<% $WRAP %>>
-% }
-% $m->callback( CallbackName => 'AfterTransactionCustomFields', TicketObj => $TicketObj, QueueObj => $QueueObj, NamePrefix => $NamePrefix );
-
-<%INIT>
-my $CustomFields;
-
-if ($TicketObj) {
- $CustomFields = $TicketObj->TransactionCustomFields();
-} else {
- $CustomFields = $QueueObj->TicketTransactionCustomFields();
-}
-
-$m->callback( CallbackName => 'MassageTransactionCustomFields', CustomFields => $CustomFields );
-
-$AsTable ||= $InTable;
-my $FIELD = $AsTable ? 'tr' : 'div';
-my $CELL = $AsTable ? 'td' : 'div';
-my $WRAP = '';
-if ( $AsTable ) {
- $WRAP = 'table' unless $InTable;
-} else {
- $WRAP = 'div';
-}
-
-</%INIT>
-<%ARGS>
-$NamePrefix => "Object-RT::Transaction--CustomField-"
-$TicketObj => undef
-$QueueObj => undef
-$AsTable => 0
-$InTable => 0
-$UILocation => ''
-</%ARGS>
-
+++ /dev/null
-%# BEGIN BPS TAGGED BLOCK {{{
-%#
-%# COPYRIGHT:
-%#
-%# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
-%# <sales@bestpractical.com>
-%#
-%# (Except where explicitly superseded by other copyright notices)
-%#
-%#
-%# LICENSE:
-%#
-%# This work is made available to you under the terms of Version 2 of
-%# the GNU General Public License. A copy of that license should have
-%# been provided with this software, but in any event can be snarfed
-%# from www.gnu.org.
-%#
-%# This work is distributed in the hope that it will be useful, but
-%# WITHOUT ANY WARRANTY; without even the implied warranty of
-%# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-%# General Public License for more details.
-%#
-%# You should have received a copy of the GNU General Public License
-%# along with this program; if not, write to the Free Software
-%# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
-%# 02110-1301 or visit their web page on the internet at
-%# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
-%#
-%#
-%# CONTRIBUTION SUBMISSION POLICY:
-%#
-%# (The following paragraph is not intended to limit the rights granted
-%# to you to modify and distribute this software under the terms of
-%# the GNU General Public License and is only of importance to you if
-%# you choose to contribute your changes and enhancements to the
-%# community by submitting them to Best Practical Solutions, LLC.)
-%#
-%# By intentionally submitting any modifications, corrections or
-%# derivatives to this work, or any other work intended for use with
-%# Request Tracker, to Best Practical Solutions, LLC, you confirm that
-%# you are the copyright holder for those contributions and you grant
-%# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
-%# royalty-free, perpetual, license to use, copy, create derivative
-%# works based on those contributions, and sublicense and distribute
-%# those contributions and any derivatives thereof.
-%#
-%# END BPS TAGGED BLOCK }}}
-<& /Elements/Header, Title => $title &>
-<& /Elements/Tabs &>
-
-% $m->callback(CallbackName => 'BeforeActionList', ARGSRef => \%ARGS, Ticket => $TicketObj);
-<& /Elements/ListActions, actions => \@results &>
-
-<form action="Update.html" name="TicketUpdate"
- method="post" enctype="multipart/form-data">
-% $m->callback( CallbackName => 'FormStart', ARGSRef => \%ARGS, Ticket => $TicketObj, CanRespond => $CanRespond, CanComment => $CanComment, ResponseDefault => $ResponseDefault, CommentDefault => $CommentDefault );
-<input type="hidden" class="hidden" name="QuoteTransaction" value="<% $ARGS{QuoteTransaction}||'' %>" />
-<input type="hidden" class="hidden" name="DefaultStatus" value="<% $DefaultStatus ||''%>" />
-<input type="hidden" class="hidden" name="Action" value="<% $ARGS{Action}||'' %>" />
-
-<& /Elements/GnuPG/SignEncryptWidget:ShowIssues, self => $gnupg_widget &>
-
-<div id="ticket-update-metadata">
- <&|/Widgets/TitleBox, title => loc('Ticket and Transaction') &>
-<table width="100%" border="0">
-% $m->callback(CallbackName => 'AfterTableOpens', ARGSRef => \%ARGS, Ticket => $TicketObj);
-
-<& /Ticket/Elements/EditTransactionCustomFields,
- %ARGS,
- TicketObj => $TicketObj,
- UILocation => 'TimeWorked',
-&>
-
-% my $skip;
-% $m->callback( %ARGS, CallbackName => 'BeforeUpdateType', skip => \$skip );
-% if (!$skip) {
-<input type="hidden" class="hidden" name="id" value="<%$TicketObj->Id%>" /><br />
-% }
-<tr><td class="label"><&|/l&>Update Type</&>:</td>
-<td><select name="UpdateType" id="UpdateType">
-% if ($CanComment) {
-<option value="private" <% ($ARGS{'UpdateType'} && $ARGS{'UpdateType'} eq "private") ? qq[ selected="selected"] : !$ARGS{'UpdateType'}&&$CommentDefault |n %>><&|/l&>Comments (Not sent to requestors)</&></option>
-% }
-% if ($CanRespond) {
-<option value="response" <% ($ARGS{'UpdateType'} && $ARGS{'UpdateType'} eq "response") ? qq[ selected="selected"] : !$ARGS{'UpdateType'}&&$ResponseDefault |n %>><&|/l&>Reply to requestors</&></option>
-% }
-</select>
-
-<script type="text/javascript">
- jQuery(function() {
- jQuery("#UpdateType").change(function(ev) {
- jQuery(".messagebox-container")
- .removeClass("action-response action-private")
- .addClass("action-"+ev.target.value);
- });
- });
- jQuery(function() {
- jQuery("input[name=TxnSendMailTo]").change(function(ev) {
- jQuery("input[name=TxnSendMailTo][value="+ev.target.value+"]")
- .attr("checked",jQuery(ev.target).attr('checked'));
- });
- });
-</script>
-
-% $m->callback( %ARGS, CallbackName => 'AfterUpdateType' );
-</td></tr>
-
-<script type="text/javascript">
-function changeStatus() {
- var Status_select = document.getElementById('Status');
- var x = Status_select.options[Status_select.selectedIndex].value;
- var text = document.getElementById('WillResolve_Date');
- var button = document.getElementById('WillResolve_Date_date_button');
- if (x == 'resolved' || x == 'rejected' || x == 'deleted') {
- text.disabled = true;
- button.style.display = 'none';
- }
- else {
- text.disabled = false;
- button.style.display = 'inline';
- }
-}
-</script>
-
-<& /Ticket/Elements/EditBasics,
- TicketObj => $TicketObj,
- InTable => 1,
- fields => [
- { name => 'Status',
- comp => '/Elements/SelectStatus',
- args => {
- Name => 'Status',
- DefaultLabel => loc("[_1] (Unchanged)", loc($TicketObj->Status)),
- Default => $ARGS{'Status'} || ($TicketObj->Status eq $DefaultStatus ? undef : $DefaultStatus),
- TicketObj => $TicketObj,
- QueueObj => $TicketObj->QueueObj,
- onchange => 'changeStatus()'
- },
- },
- { name => 'Resolve this Ticket on',
- comp => '/Elements/SelectDate',
- args => {
- menu_prefix => 'WillResolve',
- current => 0,
- ShowTime => 0,
- },
- },
- { name => 'Owner',
- comp => '/Elements/SelectOwner',
- args => {
- Name => "Owner",
- TicketObj => $TicketObj,
- QueueObj => $TicketObj->QueueObj,
- DefaultLabel => loc("[_1] (Unchanged)", $m->scomp('/Elements/ShowUser', User => $TicketObj->OwnerObj)),
- Default => $ARGS{'Owner'}
- }
- },
- { name => 'Worked',
- comp => '/Elements/EditTimeValue',
- args => {
- Name => 'UpdateTimeWorked',
- Default => $ARGS{UpdateTimeWorked}||'',
- InUnits => $ARGS{'UpdateTimeWorked-TimeUnits'}||'minutes',
- }
- },
- ]
-&>
-
-<script type="text/javascript">
-changeStatus();
-</script>
-
-% $m->callback( %ARGS, CallbackName => 'AfterWorked', Ticket => $TicketObj );
-
-<& /Ticket/Elements/EditTransactionCustomFields, %ARGS, TicketObj => $TicketObj, AsTable => 1 &>
-
- <!--</table>-->
- </&>
-</div>
-
-<div id="ticket-update-message">
- <& /Ticket/Elements/ShowSimplifiedRecipients, TicketObj => $TicketObj, %ARGS &>
-
- <&|/Widgets/TitleBox, title => loc('Message'), class => 'messagedetails' &>
- <table width="100%" border="0">
-<& /Ticket/Elements/UpdateCc, %ARGS, TicketObj => $TicketObj &>
-
-% if ( $gnupg_widget ) {
-<tr><td> </td><td>
-<& /Elements/GnuPG/SignEncryptWidget,
- self => $gnupg_widget,
- TicketObj => $TicketObj,
-&>
-</td></tr>
-% }
-% $m->callback( %ARGS, CallbackName => 'AfterGnuPG' );
-
-<tr><td class="label"><&|/l&>Subject</&>:</td><td> <input type="text" name="UpdateSubject" value="<% $ARGS{UpdateSubject} || $TicketObj->Subject || '' %>" />
-% $m->callback( %ARGS, CallbackName => 'AfterSubject' );
-</td></tr>
-
-<tr><td class="label" valign="top"><&|/l&>Message</&>:</td>
-<td class="messagebox-container action-<% $type %>">
-<& /Articles/Elements/BeforeMessageBox, %ARGS &>
-% $m->callback( %ARGS, CallbackName => 'BeforeMessageBox' );
-% if (exists $ARGS{UpdateContent}) {
-% # preserve QuoteTransaction so we can use it to set up sane references/in/reply to
-% my $temp = $ARGS{'QuoteTransaction'};
-% delete $ARGS{'QuoteTransaction'};
-<& /Elements/MessageBox, Name=>"UpdateContent", Default=>$ARGS{UpdateContent}, IncludeSignature => 0, %ARGS&>
-% $ARGS{'QuoteTransaction'} = $temp;
-% } else {
-% my $IncludeSignature = 1;
-% $IncludeSignature = 0 if $Action ne 'Respond' && !RT->Config->Get('MessageBoxIncludeSignatureOnComment');
-<& /Elements/MessageBox, Name=>"UpdateContent", IncludeSignature => $IncludeSignature, %ARGS &>
-% }
-% $m->callback( %ARGS, CallbackName => 'AfterMessageBox' );
-</td></tr>
-
- <& /Ticket/Elements/AddAttachments, %ARGS, TicketObj => $TicketObj &>
- </table>
-</&>
-
-% $m->callback( %ARGS, CallbackName => 'BeforeSubmit', Ticket => $TicketObj );
-
- <& /Elements/Submit, Label => loc('Update Ticket'), Name => 'SubmitTicket', id => 'SubmitTicket' &>
-
-% $m->callback( %ARGS, CallbackName => 'BeforeScrips', Ticket => $TicketObj );
-
-% if ($TicketObj->CurrentUserHasRight('ShowOutgoingEmail')) {
- <&|/Widgets/TitleBox, title => loc('Scrips and Recipients'), id => 'previewscrips', rolledup => RT->Config->Get('SimplifiedRecipients', $session{'CurrentUser'}) &>
- <& /Ticket/Elements/PreviewScrips, TicketObj => $TicketObj, %ARGS &>
- </&>
-% }
-</div>
-
-% $m->callback( %ARGS, CallbackName => 'AfterScrips', Ticket => $TicketObj );
-
-% if (my $recips = $m->notes("DryRun-Recipients-".$TicketObj->Id)) {
-<input type="hidden" name="TxnRecipients" value="<% join ",",sort keys %{$recips} %>" />
-% }
-
-</form>
-<hr class="clear" />
-
-% $m->callback( %ARGS, CallbackName => 'AfterForm', Ticket => $TicketObj );
-
-<%INIT>
-my $CanRespond = 0;
-my $CanComment = 0;
-my $checks_failure = 0;
-
-my $TicketObj = LoadTicket($id);
-
-my @results;
-
-$m->callback( Ticket => $TicketObj, ARGSRef => \%ARGS, checks_failure => \$checks_failure, results => \@results, CallbackName => 'Initial' );
-
-unless($DefaultStatus){
- $DefaultStatus=($ARGS{'Status'} ||$TicketObj->Status());
-}
-
-my $title = loc("Update ticket #[_1] ([_2])", $TicketObj->id, $TicketObj->Subject||'');
-
-# Things needed in the template - we'll do the processing here, just
-# for the convenience:
-
-my ($CommentDefault, $ResponseDefault);
-if ($Action ne 'Respond') {
- $CommentDefault = qq[ selected="selected"];
- $ResponseDefault = "";
-} else {
- $CommentDefault = "";
- $ResponseDefault = qq[ selected="selected"];
-}
-
-my $type = $ARGS{'UpdateType'} ? $ARGS{'UpdateType'} :
- lc $ARGS{'Action'} eq 'respond' ? 'response' :
- lc $ARGS{'Action'} eq 'comment' ? 'private' :
- 'none' ;
-
-
-$CanRespond = 1 if ( $TicketObj->CurrentUserHasRight('ReplyToTicket') or
- $TicketObj->CurrentUserHasRight('ModifyTicket') );
-
-$CanComment = 1 if ( $TicketObj->CurrentUserHasRight('CommentOnTicket') or
- $TicketObj->CurrentUserHasRight('ModifyTicket') );
-
-
-ProcessAttachments(ARGSRef => \%ARGS);
-
-my $gnupg_widget = $m->comp('/Elements/GnuPG/SignEncryptWidget:new', Arguments => \%ARGS );
-$m->comp( '/Elements/GnuPG/SignEncryptWidget:Process',
- self => $gnupg_widget,
- TicketObj => $TicketObj,
-);
-
-if ( $ARGS{'SubmitTicket'} ) {
-
- my %squelched = ProcessTransactionSquelching( \%ARGS );
- $ARGS{'SquelchMailTo'} = [keys %squelched] if keys %squelched;
-
- my $CFs = $TicketObj->TransactionCustomFields;
- my $ValidCFs = $m->comp(
- '/Elements/ValidateCustomFields',
- CustomFields => $CFs,
- NamePrefix => "Object-RT::Transaction--CustomField-",
- ARGSRef => \%ARGS
- );
- unless ( $ValidCFs ) {
- $checks_failure = 1;
- while (my $CF = $CFs->Next) {
- my $msg = $m->notes('InvalidField-' . $CF->Id) or next;
- push @results, loc($CF->Name) . ': ' . $msg;
- }
- }
- my $status = $m->comp('/Elements/GnuPG/SignEncryptWidget:Check',
- self => $gnupg_widget,
- TicketObj => $TicketObj,
- );
- $checks_failure = 1 unless $status;
-}
-
-# check email addresses for RT's
-{
- foreach my $field ( qw(UpdateCc UpdateBcc) ) {
- my $value = $ARGS{ $field };
- next unless defined $value && length $value;
-
- my @emails = Email::Address->parse( $value );
- foreach my $email ( grep RT::EmailParser->IsRTAddress($_->address), @emails ) {
- push @results, loc("[_1] is an address RT receives mail at. Adding it as a '[_2]' would create a mail loop", $email->format, loc(substr($field, 6)) );
- $checks_failure = 1;
- $email = undef;
- }
- $ARGS{ $field } = join ', ', map $_->format, grep defined, @emails;
- }
-}
-my $skip_update = 0;
-$m->callback( CallbackName => 'BeforeUpdate', ARGSRef => \%ARGS, skip_update => \$skip_update,
- checks_failure => $checks_failure, results => \@results, TicketObj => $TicketObj );
-
-if ( !$checks_failure && !$skip_update && exists $ARGS{SubmitTicket} ) {
- $m->callback( Ticket => $TicketObj, ARGSRef => \%ARGS, CallbackName => 'BeforeDisplay' );
- return $m->comp('Display.html', TicketObj => $TicketObj, %ARGS);
-}
-</%INIT>
-
-<%ARGS>
-$id => undef
-$Action => undef
-$DefaultStatus => undef
-</%ARGS>
projects / freeside.git / commitdiff