[Bps-public-commit] RT-Extension-TicketLocking branch, master, created. 65ba06df76713d2b07e68bc21054f8fd6143a1c9
? sunnavy
sunnavy at bestpractical.com
Tue Nov 23 19:38:57 EST 2010
The branch, master has been created
at 65ba06df76713d2b07e68bc21054f8fd6143a1c9 (commit)
- Log -----------------------------------------------------------------
commit 2a9414fb918b65226aaf45e426726dc5de7e140a
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 14:48:23 2007 +0000
* Added TicketLocking extension directory
commit 8953e071c28c976f11dab0d2e08fcc94228826b4
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 14:49:54 2007 +0000
* Added TicketLocking extension
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..eec9aea
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,17 @@
+html/Elements/MyLocks
+html/Elements/ShowLock
+html/Callbacks/Locking/Ticket/Display.html/ProcessLockArgument
+html/Callbacks/Locking/Ticket/Display.html/ShowLock
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/RTx.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/RT/Extension/TicketLocking.pm
+Makefile.PL
+MANIFEST
+README
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..a476571
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,770 @@
+# This Makefile is for the RT::Extension::TicketLocking extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 6.30_01 (Revision: Revision: 4535 ) from the contents of
+# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
+#
+# ANY CHANGES MADE HERE WILL BE LOST!
+#
+# MakeMaker ARGV: ()
+#
+# MakeMaker Parameters:
+
+# ABSTRACT => q[Enables users to place advisory locks on tickets]
+# AUTHOR => q[Turner Hayes <thayes at bestpractical.com>]
+# DIR => []
+# DISTNAME => q[RT-Extension-TicketLocking]
+# INSTALLSITELIB => q[/opt/rt3/local/lib]
+# NAME => q[RT::Extension::TicketLocking]
+# NO_META => q[1]
+# PL_FILES => { }
+# PREREQ_PM => { Test::More=>q[0] }
+# VERSION => q[0.01]
+# dist => { }
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm)
+
+# They may have been overridden via Makefile.PL or on the command line
+AR = ar
+CC = cc
+CCCDLFLAGS = -fPIC
+CCDLFLAGS = -Wl,-E
+DLEXT = so
+DLSRC = dl_dlopen.xs
+LD = cc
+LDDLFLAGS = -shared -L/usr/local/lib
+LDFLAGS = -L/usr/local/lib
+LIBC = /lib/libc-2.5.so
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 2.6.15.7
+RANLIB = :
+SITELIBEXP = /usr/local/share/perl/5.8.8
+SITEARCHEXP = /usr/local/lib/perl/5.8.8
+SO = so
+EXE_EXT =
+FULL_AR = /usr/bin/ar
+VENDORARCHEXP = /usr/lib/perl5
+VENDORLIBEXP = /usr/share/perl5
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+DIRFILESEP = /
+DFSEP = $(DIRFILESEP)
+NAME = RT::Extension::TicketLocking
+NAME_SYM = RT_Extension_TicketLocking
+VERSION = 0.01
+VERSION_MACRO = VERSION
+VERSION_SYM = 0_01
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION = 0.01
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+INST_BIN = blib/bin
+INST_LIB = blib/lib
+INST_MAN1DIR = blib/man1
+INST_MAN3DIR = blib/man3
+MAN1EXT = 1p
+MAN3EXT = 3pm
+INSTALLDIRS = site
+DESTDIR =
+PREFIX = /usr
+PERLPREFIX = $(PREFIX)
+SITEPREFIX = $(PREFIX)/local
+VENDORPREFIX = $(PREFIX)
+INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8
+DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
+INSTALLSITELIB = /opt/rt3/local/lib
+DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
+INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
+DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
+INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8
+DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
+INSTALLSITEARCH = /usr/local/lib/perl/5.8.8
+DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
+INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
+DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
+INSTALLBIN = $(PERLPREFIX)/bin
+DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
+INSTALLSITEBIN = $(SITEPREFIX)/bin
+DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
+INSTALLVENDORBIN = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
+INSTALLSCRIPT = $(PERLPREFIX)/bin
+DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
+INSTALLSITESCRIPT = $(SITEPREFIX)/bin
+DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
+INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
+DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
+INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
+DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
+INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
+DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
+INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
+DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
+INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
+DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
+INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
+DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
+INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
+DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
+PERL_LIB =
+PERL_ARCHLIB = /usr/lib/perl/5.8
+LIBPERL_A = libperl.a
+FIRST_MAKEFILE = Makefile
+MAKEFILE_OLD = Makefile.old
+MAKE_APERL_FILE = Makefile.aperl
+PERLMAINCC = $(CC)
+PERL_INC = /usr/lib/perl/5.8/CORE
+PERL = /usr/bin/perl "-Iinc"
+FULLPERL = /usr/bin/perl "-Iinc"
+ABSPERL = $(PERL)
+PERLRUN = $(PERL)
+FULLPERLRUN = $(FULLPERL)
+ABSPERLRUN = $(ABSPERL)
+PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
+FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
+ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
+PERL_CORE = 0
+PERM_RW = 644
+PERM_RWX = 755
+
+MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm
+MM_VERSION = 6.30_01
+MM_REVISION = Revision: 4535
+
+# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
+# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
+FULLEXT = RT/Extension/TicketLocking
+BASEEXT = TicketLocking
+PARENT_NAME = RT::Extension
+DLBASE = $(BASEEXT)
+VERSION_FROM =
+OBJECT =
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+BOOTDEP =
+
+# Handy lists of source code files:
+XS_FILES =
+C_FILES =
+O_FILES =
+H_FILES =
+MAN1PODS =
+MAN3PODS = lib/RT/Extension/TicketLocking.pm
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
+
+# Where to build things
+INST_LIBDIR = $(INST_LIB)/RT/Extension
+INST_ARCHLIBDIR = $(INST_ARCHLIB)/RT/Extension
+
+INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC =
+INST_DYNAMIC =
+INST_BOOT =
+
+# Extra linker info
+EXPORT_LIST =
+PERL_ARCHIVE =
+PERL_ARCHIVE_AFTER =
+
+
+TO_INST_PM = lib/RT/Extension/TicketLocking.pm
+
+PM_TO_BLIB = lib/RT/Extension/TicketLocking.pm \
+ blib/lib/RT/Extension/TicketLocking.pm
+
+
+# --- MakeMaker platform_constants section:
+MM_Unix_VERSION = 1.50_01
+PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
+
+
+# --- MakeMaker tool_autosplit section:
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)'
+
+
+
+# --- MakeMaker tool_xsubpp section:
+
+
+# --- MakeMaker tools_other section:
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+MV = mv
+NOOP = $(SHELL) -c true
+NOECHO = @
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
+EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
+ECHO = echo
+ECHO_N = echo -n
+UNINST = 0
+VERBINST = 0
+MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');'
+DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install
+UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall
+WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist
+MACROSTART =
+MACROEND =
+USEMAKEFILE = -f
+FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"
+
+
+# --- MakeMaker makemakerdflt section:
+makemakerdflt: all
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dist section:
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = $(NOECHO) $(NOOP)
+POSTOP = $(NOECHO) $(NOOP)
+TO_UNIX = $(NOECHO) $(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+DISTNAME = RT-Extension-TicketLocking
+DISTVNAME = RT-Extension-TicketLocking-0.01
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+
+# --- MakeMaker const_loadlibs section:
+
+
+# --- MakeMaker const_cccmd section:
+
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
+ LINKTYPE="$(LINKTYPE)"\
+ PREFIX="$(PREFIX)"
+
+
+# --- MakeMaker special_targets section:
+.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
+
+.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
+
+
+
+# --- MakeMaker c_o section:
+
+
+# --- MakeMaker xs_c section:
+
+
+# --- MakeMaker xs_o section:
+
+
+# --- MakeMaker top_targets section:
+all :: pure_all manifypods
+ $(NOECHO) $(NOOP)
+
+
+pure_all :: config pm_to_blib subdirs linkext
+ $(NOECHO) $(NOOP)
+
+subdirs :: $(MYEXTLIB)
+ $(NOECHO) $(NOOP)
+
+config :: $(FIRST_MAKEFILE) blibdirs
+ $(NOECHO) $(NOOP)
+
+help :
+ perldoc ExtUtils::MakeMaker
+
+
+# --- MakeMaker blibdirs section:
+blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
+ $(NOECHO) $(NOOP)
+
+# Backwards compat with 6.18 through 6.25
+blibdirs.ts : blibdirs
+ $(NOECHO) $(NOOP)
+
+$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_LIBDIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
+ $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
+
+$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
+ $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
+
+$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_AUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
+
+$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
+ $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
+
+$(INST_BIN)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_BIN)
+ $(NOECHO) $(CHMOD) 755 $(INST_BIN)
+ $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
+
+$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_SCRIPT)
+ $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
+ $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
+
+$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
+
+$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
+ $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
+ $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
+ $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
+
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP =
+
+
+# --- MakeMaker dynamic_lib section:
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+static :: $(FIRST_MAKEFILE) $(INST_STATIC)
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+
+# --- MakeMaker manifypods section:
+
+POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
+POD2MAN = $(POD2MAN_EXE)
+
+
+manifypods : pure_all \
+ lib/RT/Extension/TicketLocking.pm \
+ lib/RT/Extension/TicketLocking.pm
+ $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
+ lib/RT/Extension/TicketLocking.pm $(INST_MAN3DIR)/RT::Extension::TicketLocking.$(MAN3EXT)
+
+
+
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean_subdirs section:
+clean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# the Makefile here so a later make realclean still has a makefile to use.
+
+clean :: clean_subdirs
+ - $(RM_F) \
+ *$(LIB_EXT) core \
+ core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
+ core.[0-9][0-9] $(BASEEXT).bso \
+ pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
+ $(BASEEXT).x $(BOOTSTRAP) \
+ perl$(EXE_EXT) tmon.out \
+ *$(OBJ_EXT) pm_to_blib \
+ $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \
+ core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
+ core.*perl.*.? $(MAKE_APERL_FILE) \
+ perl $(BASEEXT).def \
+ core.[0-9][0-9][0-9] mon.out \
+ lib$(BASEEXT).def perlmain.c \
+ perl.exe so_locations \
+ $(BASEEXT).exp
+ - $(RM_RF) \
+ blib
+ - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
+
+
+# --- MakeMaker realclean_subdirs section:
+realclean_subdirs :
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker realclean section:
+# Delete temporary files (via clean) and also delete dist files
+realclean purge :: clean realclean_subdirs
+ - $(RM_F) \
+ $(MAKEFILE_OLD) $(FIRST_MAKEFILE)
+ - $(RM_RF) \
+ $(DISTVNAME)
+
+
+# --- MakeMaker metafile section:
+metafile:
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker signature section:
+signature :
+ cpansign -s
+
+
+# --- MakeMaker dist_basics section:
+distclean :: realclean distcheck
+ $(NOECHO) $(NOOP)
+
+distcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
+
+skipcheck :
+ $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
+
+manifest :
+ $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
+
+veryclean : realclean
+ $(RM_F) *~ *.orig */*~ */*.orig
+
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
+ $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
+ -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';'
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+ $(NOECHO) $(NOOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+ uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+ $(PREOP)
+ $(TO_UNIX)
+ $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(COMPRESS) $(DISTVNAME).tar
+ $(POSTOP)
+
+zipdist : $(DISTVNAME).zip
+ $(NOECHO) $(NOOP)
+
+$(DISTVNAME).zip : distdir
+ $(PREOP)
+ $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+shdist : distdir
+ $(PREOP)
+ $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+
+# --- MakeMaker distdir section:
+create_distdir :
+ $(RM_RF) $(DISTVNAME)
+ $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
+ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+distdir : create_distdir
+ $(NOECHO) $(NOOP)
+
+
+
+# --- MakeMaker dist_test section:
+disttest : distdir
+ cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
+ cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
+ cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
+
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+ $(PERLRUN) "-MExtUtils::Manifest=maniread" \
+ -e "@all = keys %{ maniread() };" \
+ -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
+ -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
+
+
+# --- MakeMaker distmeta section:
+distmeta : create_distdir metafile
+ $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
+ -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"'
+
+
+
+# --- MakeMaker distsignature section:
+distsignature : create_distdir
+ $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
+ -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"'
+ $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
+ cd $(DISTVNAME) && cpansign -s
+
+
+
+# --- MakeMaker install section:
+
+install :: all pure_install doc_install
+ $(NOECHO) $(NOOP)
+
+install_perl :: all pure_perl_install doc_perl_install
+ $(NOECHO) $(NOOP)
+
+install_site :: all pure_site_install doc_site_install
+ $(NOECHO) $(NOOP)
+
+install_vendor :: all pure_vendor_install doc_vendor_install
+ $(NOECHO) $(NOOP)
+
+pure_install :: pure_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+doc_install :: doc_$(INSTALLDIRS)_install
+ $(NOECHO) $(NOOP)
+
+pure__install : pure_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+ $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+ $(NOECHO) umask 022; $(MOD_INSTALL) \
+ $(INST_LIB) $(DESTINSTALLPRIVLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
+ $(INST_BIN) $(DESTINSTALLBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install ::
+ $(NOECHO) umask 02; $(MOD_INSTALL) \
+ read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+ write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(DESTINSTALLSITELIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
+ $(INST_BIN) $(DESTINSTALLSITEBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
+ $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
+ $(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+pure_vendor_install ::
+ $(NOECHO) umask 022; $(MOD_INSTALL) \
+ $(INST_LIB) $(DESTINSTALLVENDORLIB) \
+ $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
+ $(INST_BIN) $(DESTINSTALLVENDORBIN) \
+ $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
+ $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
+ $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
+
+doc_perl_install ::
+
+doc_site_install ::
+ $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
+ -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
+ -$(NOECHO) umask 02; $(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLSITELIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(DESTINSTALLSITEARCH)/perllocal.pod
+
+doc_vendor_install ::
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+ $(NOECHO) $(NOOP)
+
+uninstall_from_perldirs ::
+
+uninstall_from_sitedirs ::
+ $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_vendordirs ::
+
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE:
+ $(NOECHO) $(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+
+# --- MakeMaker makefile section:
+# We take a very conservative approach here, but it's worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
+ $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
+ $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
+ -$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
+ -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
+ - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
+ $(PERLRUN) Makefile.PL
+ $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
+ $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
+ false
+
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET = perl
+FULLPERL = /usr/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+ $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
+ $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+ $(NOECHO) $(PERLRUNINST) \
+ Makefile.PL DIR= \
+ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES =
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE)
+ $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.'
+
+test_dynamic :: pure_all
+
+testdb_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-Iinc" "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: test_dynamic
+testdb_static :: testdb_dynamic
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd:
+ $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="0,01,0,0">' > $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <TITLE>$(DISTNAME)</TITLE>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <ABSTRACT>Enables users to place advisory locks on tickets</ABSTRACT>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <AUTHOR>Turner Hayes <thayes at bestpractical.com></AUTHOR>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-More" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <OS NAME="$(OSNAME)" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="i486-linux-gnu-thread-multi" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
+ $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
+
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib : $(TO_INST_PM)
+ $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \
+ lib/RT/Extension/TicketLocking.pm blib/lib/RT/Extension/TicketLocking.pm
+ $(NOECHO) $(TOUCH) pm_to_blib
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+
+
+# End.
+# Postamble by Module::Install 0.67
+install ::
+ $(NOECHO) $(PERL) -MExtUtils::Install -e "install({q(html), q(/opt/rt3/share/html)})"
+
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..913f683
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,10 @@
+use inc::Module::Install;
+
+RTx('RT-Extension-TicketLocking');
+author ('Turner Hayes <thayes at bestpractical.com>');
+version_from ('lib/RT/Extension/TicketLocking.pm');
+abstract_from('lib/RT/Extension/TicketLocking.pm');
+license('perl');
+requires('Test::More');
+
+&WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..c6217b5
--- /dev/null
+++ b/README
@@ -0,0 +1,57 @@
+RT-Extension-TicketLocking
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make install
+
+
+To use this module, you must add the line
+
+ use RT::Extension::TicketLocking;
+
+to the bottom of your RT_SiteConfig.pm file.
+
+
+If you want the MyLocks portlet to be available from the RT at a Glance page, you will need to
+enable it with a line like this in your RT_SiteConfig.pm file
+
+Set($HomepageComponents, [qw(QuickCreate Quicksearch MyAdminQueues MySupportQueues MyReminders
+ RefreshHomepage MyLocks)]);
+
+This is the default portlet list with MyLocks added to the end. People can then choose to add
+the portlet to their homepage in Preferences -> RT at a glance.
+
+
+If you are running RTIR, and want the portlet to be available from the RTIR home page, you will
+need to do something similar to set the RTIR_HomepageComponents array in your RTIR_Config.pm file,
+like this:
+
+Set(@RTIR_HomepageComponents, qw(
+ QuickCreate
+ Quicksearch
+ MyAdminQueues
+ MySupportQueues
+ MyReminders
+ /RTIR/Elements/NewReports
+ /RTIR/Elements/UserDueIncidents
+ /RTIR/Elements/NobodyDueIncidents
+ /RTIR/Elements/DueIncidents
+ /RTIR/Elements/QueueSummary
+ RefreshHomepage
+ MyLocks
+));
+
+This is the default RTIR portlet list with MyLocks added to the end. People can then choose to add
+the portlet to their homepage in Preferences -> RTIR Home.
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2007, Best Practical Solutions LLC.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
diff --git a/blib/arch/.exists b/blib/arch/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/arch/auto/RT/Extension/TicketLocking/.exists b/blib/arch/auto/RT/Extension/TicketLocking/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/bin/.exists b/blib/bin/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/lib/RT/Extension/.exists b/blib/lib/RT/Extension/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/lib/RT/Extension/TicketLocking.pm b/blib/lib/RT/Extension/TicketLocking.pm
new file mode 100644
index 0000000..ba8749f
--- /dev/null
+++ b/blib/lib/RT/Extension/TicketLocking.pm
@@ -0,0 +1,175 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse at 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/copyleft/gpl.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::Ticket;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+RT::Extension::TicketLocking - Enables users to place advisory locks on tickets
+
+=cut
+
+our @LockTypes = qw(Auto Hard);
+
+sub Locked {
+ my $ticket = shift;
+ my $lock = $ticket->FirstAttribute('RT_Lock');
+ if($lock) {
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ my $expiry = RT->Config->Get('LockExpiry');
+ if($expiry) {
+ unless($duration < $expiry) {
+ $ticket->DeleteAttribute('RT_Lock');
+ undef $lock;
+ }
+ }
+ }
+ return $lock;
+}
+
+sub Lock {
+ my $ticket = shift;
+ my $type = shift || 'Auto';
+
+ if ( my $lock = $ticket->Locked() ) {
+ return undef if $lock->Content->{'User'} != $ticket->CurrentUser->id;
+ my $LockType = $lock->Content->{'Type'};
+ my $priority;
+ my $LockPriority;
+ for(my $i = 0; $i < scalar @LockTypes; $i++) {
+ $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
+ $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
+ }
+ return undef if $priority <= $LockPriority;
+ }
+ $ticket->Unlock($type); #Remove any existing locks (because this one has greater priority)
+ my $id = $ticket->id;
+ my $username = $ticket->CurrentUser->Name;
+ $ticket->SetAttribute(
+ Name => 'RT_Lock',
+ Description => "$type lock on Ticket $id by user $username",
+ Content => {
+ User => $ticket->CurrentUser->id,
+ Timestamp => time(),
+ Type => $type,
+ Ticket => $id
+ }
+ );
+}
+
+
+sub Unlock {
+ my $ticket = shift;
+ my $type = shift || 'Auto';
+
+ my $lock = $ticket->RT::Ticket::Locked();
+ return (undef, "This ticket was not locked.") unless $lock;
+ return (undef, "You cannot unlock a ticket locked by another user.") unless $lock->Content->{User} == $ticket->CurrentUser->id;
+
+ my $LockType = $lock->Content->{'Type'};
+ my $priority;
+ my $LockPriority;
+ for(my $i = 0; $i < scalar @LockTypes; $i++) {
+ $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
+ $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
+ }
+ return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ $ticket->DeleteAttribute('RT_Lock');
+ return ($duration, "You have unlocked this ticket.");
+}
+
+
+sub BreakLock {
+ my $ticket = shift;
+ return $ticket->DeleteAttribute('RT_Lock');
+}
+
+
+
+
+
+package RT::User;
+
+sub GetLocks {
+ my $self = shift;
+
+ my $attribs = RT::Attributes->new($self);
+ $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
+
+ my $expiry = RT->Config->Get('LockExpiry');
+ return $attribs->Named('RT_Lock') unless $expiry;
+ my @locks;
+
+ foreach my $lock ($attribs->Named('RT_Lock')) {
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ if($duration < $expiry) {
+ push @locks, $lock;
+ }
+ else {
+ $lock->Delete();
+ }
+ }
+ return @locks;
+}
+
+sub RemoveLocks {
+ my $self = shift;
+
+ my $attribs = RT::Attributes->new($self);
+ $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
+ my @attributes = $attribs->Named('RT_Lock');
+ foreach my $lock (@attributes) {
+ $lock->Delete();
+ }
+}
diff --git a/blib/lib/auto/RT/Extension/TicketLocking/.exists b/blib/lib/auto/RT/Extension/TicketLocking/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/man1/.exists b/blib/man1/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/man3/.exists b/blib/man3/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/blib/man3/RT::Extension::TicketLocking.3pm b/blib/man3/RT::Extension::TicketLocking.3pm
new file mode 100644
index 0000000..2da3895
--- /dev/null
+++ b/blib/man3/RT::Extension::TicketLocking.3pm
@@ -0,0 +1,134 @@
+.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
+.\"
+.\" Standard preamble:
+.\" ========================================================================
+.de Sh \" Subsection heading
+.br
+.if t .Sp
+.ne 5
+.PP
+\fB\\$1\fR
+.PP
+..
+.de Sp \" Vertical space (when we can't use .PP)
+.if t .sp .5v
+.if n .sp
+..
+.de Vb \" Begin verbatim text
+.ft CW
+.nf
+.ne \\$1
+..
+.de Ve \" End verbatim text
+.ft R
+.fi
+..
+.\" Set up some character translations and predefined strings. \*(-- will
+.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
+.\" double quote, and \*(R" will give a right double quote. \*(C+ will
+.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
+.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
+.\" nothing in troff, for use with C<>.
+.tr \(*W-
+.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
+.ie n \{\
+. ds -- \(*W-
+. ds PI pi
+. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
+. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
+. ds L" ""
+. ds R" ""
+. ds C` ""
+. ds C' ""
+'br\}
+.el\{\
+. ds -- \|\(em\|
+. ds PI \(*p
+. ds L" ``
+. ds R" ''
+'br\}
+.\"
+.\" If the F register is turned on, we'll generate index entries on stderr for
+.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
+.\" entries marked with X<> in POD. Of course, you'll have to process the
+.\" output yourself in some meaningful fashion.
+.if \nF \{\
+. de IX
+. tm Index:\\$1\t\\n%\t"\\$2"
+..
+. nr % 0
+. rr F
+.\}
+.\"
+.\" For nroff, turn off justification. Always turn off hyphenation; it makes
+.\" way too many mistakes in technical documents.
+.hy 0
+.if n .na
+.\"
+.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
+.\" Fear. Run. Save yourself. No user-serviceable parts.
+. \" fudge factors for nroff and troff
+.if n \{\
+. ds #H 0
+. ds #V .8m
+. ds #F .3m
+. ds #[ \f1
+. ds #] \fP
+.\}
+.if t \{\
+. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
+. ds #V .6m
+. ds #F 0
+. ds #[ \&
+. ds #] \&
+.\}
+. \" simple accents for nroff and troff
+.if n \{\
+. ds ' \&
+. ds ` \&
+. ds ^ \&
+. ds , \&
+. ds ~ ~
+. ds /
+.\}
+.if t \{\
+. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
+. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
+. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
+. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
+. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
+. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
+.\}
+. \" troff and (daisy-wheel) nroff accents
+.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
+.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
+.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
+.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
+.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
+.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
+.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
+.ds ae a\h'-(\w'a'u*4/10)'e
+.ds Ae A\h'-(\w'A'u*4/10)'E
+. \" corrections for vroff
+.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
+.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
+. \" for low resolution devices (crt and lpr)
+.if \n(.H>23 .if \n(.V>19 \
+\{\
+. ds : e
+. ds 8 ss
+. ds o a
+. ds d- d\h'-1'\(ga
+. ds D- D\h'-1'\(hy
+. ds th \o'bp'
+. ds Th \o'LP'
+. ds ae ae
+. ds Ae AE
+.\}
+.rm #[ #] #H #V #F C
+.\" ========================================================================
+.\"
+.IX Title "RT::Extension::TicketLocking 3pm"
+.TH RT::Extension::TicketLocking 3pm "2007-08-14" "perl v5.8.8" "User Contributed Perl Documentation"
+.SH "NAME"
+RT::Extension::TicketLocking \- Enables users to place advisory locks on tickets
diff --git a/blib/script/.exists b/blib/script/.exists
new file mode 100644
index 0000000..e69de29
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
new file mode 100644
index 0000000..b62b886
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
@@ -0,0 +1,12 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+if($Ticket) {
+ my ($d) = $Ticket->Unlock();
+ $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+ $$ARGSref{'Id'} = $Ticket->id;
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessLockArgument
new file mode 100644
index 0000000..ce79833
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessLockArgument
@@ -0,0 +1,30 @@
+<%ARGS>
+$Ticket
+$Actions => undef
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my $Lock = $$ARGSref{'Lock'};
+return unless $Lock;
+if ($Lock eq 'add') {
+ if ($Ticket->Lock('Hard')) {
+ push @$Actions, loc('You now have a lock on this ticket');
+ } else {
+ push @$Actions, loc('Your attempt to lock this ticket failed');
+ }
+ return;
+}
+if ( $Lock eq 'remove' ) {
+ my ($elapsed, $msg) = $Ticket->Unlock('Hard');
+ push @$Actions, loc($msg);
+ #print "Elapsed: $elapsed";
+ $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ return;
+}
+if ($Lock eq 'break') {
+ $Ticket->BreakLock();
+ push @$Actions, loc('You have broken the lock on this ticket');
+}
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/TicketTakeOrSteal b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/TicketTakeOrSteal
new file mode 100644
index 0000000..c793b02
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/TicketTakeOrSteal
@@ -0,0 +1,12 @@
+<%ARGS>
+$Ticket
+$Type
+$Results
+</%ARGS>
+
+<%INIT>
+if($Type eq 'Report' && !RT::IR::Ticket::IsLinkedToActiveIncidents($Ticket)) {
+ $Ticket->Lock('Take');
+ push @$Results, 'You have a lock on this report until you link it to an incident';
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
new file mode 100644
index 0000000..0c821cd
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
@@ -0,0 +1,9 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my ($d) = $Ticket->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Elements/QueueTabs/Default b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Elements/QueueTabs/Default
new file mode 100644
index 0000000..4ad85f2
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Elements/QueueTabs/Default
@@ -0,0 +1,27 @@
+<%ARGS>
+$Ticket
+$actions
+</%ARGS>
+
+<%INIT>
+return unless $Ticket;
+if (my $Lock = $Ticket->Locked()) {
+ if ($Lock->Content->{'User'} == $session{'CurrentUser'}->id) {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=remove&id=" . $Ticket->Id,
+ title => loc('Unlock')
+ };
+ } else {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=break&id=" . $Ticket->Id,
+ title => loc('Break lock')
+ };
+
+ }
+} else {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=add&id=" . $Ticket->Id,
+ title => loc('Lock')
+ };
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
new file mode 100644
index 0000000..f337902
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
@@ -0,0 +1,12 @@
+<%ARGS>
+$Child
+$ARGSref
+</%ARGS>
+
+
+<%INIT>
+return unless $Child;
+$$ARGSref{'Id'} = $Child->id;
+my ($d) = $Child->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident
new file mode 100644
index 0000000..20dad2b
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident
@@ -0,0 +1,13 @@
+<%ARGS>
+$Child
+$ARGSref
+</%ARGS>
+
+<%INIT>
+# We don't want to bother even trying to lock if the form has been submitted
+# (it will have been locked upon first rendering of the creation page)
+unless($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'}) {
+ $Child->Lock();
+}
+$$ARGSref{'Id'} = $$ARGSref{'Child'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted
new file mode 100644
index 0000000..8d960cb
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted
@@ -0,0 +1,10 @@
+<%ARGS>
+$Ticket
+$ARGSref
+</%ARGS>
+
+<%INIT>
+$$ARGSref{'Id'} = $$ARGSref{'Ticket'};
+my ($d) = $Ticket->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessLockArgument
new file mode 100644
index 0000000..cc70b7a
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessLockArgument
@@ -0,0 +1,29 @@
+<%ARGS>
+$Ticket
+$Actions => undef
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my $Lock = $$ARGSref{'Lock'};
+return unless $Lock;
+if ($Lock eq 'add') {
+ if ($Ticket->Lock('Hard')) {
+ push @$Actions, loc('You now have a lock on this ticket');
+ } else {
+ push @$Actions, loc('Your attempt to lock this ticket failed');
+ }
+ return;
+}
+if ( $Lock eq 'remove' ) {
+ my ($elapsed, $msg) = $Ticket->Unlock('Hard');
+ push @$Actions, loc($msg);
+ $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ return;
+}
+if ($Lock eq 'break') {
+ $Ticket->BreakLock();
+ push @$Actions, loc('You have broken the lock on this ticket');
+}
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
new file mode 100644
index 0000000..914fb70
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
@@ -0,0 +1,9 @@
+<%ARGS>
+$Child
+$ARGSref
+</%ARGS>
+
+<%INIT>
+my ($d) = $Child->Unlock('Take');
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
new file mode 100644
index 0000000..0c821cd
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
@@ -0,0 +1,9 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my ($d) = $Ticket->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Split.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Split.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Split.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/MergeTicketSelected b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/MergeTicketSelected
new file mode 100644
index 0000000..23d4769
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/MergeTicketSelected
@@ -0,0 +1,12 @@
+<%ARGS>
+$MergeFrom
+$MergeTo
+</%ARGS>
+
+<%INIT>
+if(my $lock = $MergeFrom->Locked()) {
+ my $lockType = $lock->Content->{'Type'};
+ $MergeTo->Lock($lockType) unless $lockType eq 'Auto';
+ $MergeFrom->Unlock('Hard'); #We don't need any locks on the merged-from ticket, since it's now the merge-to ticket
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Split.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Split.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Split.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
new file mode 100644
index 0000000..0c821cd
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
@@ -0,0 +1,9 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my ($d) = $Ticket->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessLockArgument
new file mode 100644
index 0000000..cc70b7a
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessLockArgument
@@ -0,0 +1,29 @@
+<%ARGS>
+$Ticket
+$Actions => undef
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my $Lock = $$ARGSref{'Lock'};
+return unless $Lock;
+if ($Lock eq 'add') {
+ if ($Ticket->Lock('Hard')) {
+ push @$Actions, loc('You now have a lock on this ticket');
+ } else {
+ push @$Actions, loc('Your attempt to lock this ticket failed');
+ }
+ return;
+}
+if ( $Lock eq 'remove' ) {
+ my ($elapsed, $msg) = $Ticket->Unlock('Hard');
+ push @$Actions, loc($msg);
+ $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ return;
+}
+if ($Lock eq 'break') {
+ $Ticket->BreakLock();
+ push @$Actions, loc('You have broken the lock on this ticket');
+}
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
new file mode 100644
index 0000000..4ad85f2
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
@@ -0,0 +1,27 @@
+<%ARGS>
+$Ticket
+$actions
+</%ARGS>
+
+<%INIT>
+return unless $Ticket;
+if (my $Lock = $Ticket->Locked()) {
+ if ($Lock->Content->{'User'} == $session{'CurrentUser'}->id) {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=remove&id=" . $Ticket->Id,
+ title => loc('Unlock')
+ };
+ } else {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=break&id=" . $Ticket->Id,
+ title => loc('Break lock')
+ };
+
+ }
+} else {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=add&id=" . $Ticket->Id,
+ title => loc('Lock')
+ };
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
new file mode 100644
index 0000000..29e3b51
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
@@ -0,0 +1,11 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+if($Ticket) {
+ my ($d) = $Ticket->Unlock();
+ $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/Initial b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/Initial
new file mode 100644
index 0000000..ea808f9
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/Initial
@@ -0,0 +1,7 @@
+<%ARGS>
+$Ticket
+</%ARGS>
+
+<%INIT>
+$Ticket->Lock();
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/ShowLock
new file mode 100644
index 0000000..c153e18
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/ShowLock
@@ -0,0 +1,4 @@
+<%INIT>
+$m->comp('/Elements/ShowLock', %ARGS);
+return;
+</%INIT>
diff --git a/html/Elements/MyLocks b/html/Elements/MyLocks
new file mode 100644
index 0000000..4e4eda4
--- /dev/null
+++ b/html/Elements/MyLocks
@@ -0,0 +1,105 @@
+%# BEGIN BPS TAGGED BLOCK {{{
+%#
+%# COPYRIGHT:
+%#
+%# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+%# <jesse at 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/copyleft/gpl.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 }}}
+
+% if(@locks) {
+ <&|'/Widgets/TitleBox', title => loc("Tickets locked by you") &>
+ <a href="index.html?UnlockAll=1">Unlock all</a>
+ <table border="0" cellspacing="0" cellpadding="1" width="100%">
+
+<%PERL>
+ my $expire_title;
+ $expire_title = {title => '__Expires in__'} if $expiry;
+ $m->comp('/Elements/CollectionAsTable/Header',
+ Format => [{title => '__#__'}, {title => '__Subject__'}, {title => '__Time Locked__'}, $expire_title, {title => 'NBSP'}],
+ maxitems => ($expiry ? 5 : 4)
+ );
+
+ my $Ticket = RT::Ticket->new(RT::SystemUser());
+ my $i = 1;
+ foreach my $lock (@locks) {
+ my $date = RT::Date->new($session{'CurrentUser'});
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ my $expiryTime;
+ $expiryTime = $date->DurationAsString($expiry - $duration) if $expiry;
+ my $id = $lock->Content->{'Ticket'};
+ $Ticket->Load($id);
+ my $subject = $Ticket->Subject;
+ $m->comp('/Elements/CollectionAsTable/Row',
+ Format => [{output => ["<a href=\"${RT::WebPath}/Ticket/Display.html?id=$id\">$id</a>"]},
+ {output => ["<a href=\"${RT::WebPath}/Ticket/Display.html?id=$id\">$subject</a>"]},
+ {output => [$date->DurationAsString($duration)]},
+ {output => [$expiryTime]},
+ {output => ["<a href=\"${RT::WebPath}/Ticket/Display.html?id=$id&Lock=remove\">Unlock</a>"]}],
+ maxitems => ($expiry ? 5 : 4),
+ i => $i
+ );
+ $i++;
+ }
+</%PERL>
+</table>
+</&>
+%}
+
+<%INIT>
+print "ARGS: ";
+foreach(keys %ARGS) {
+ print "$_ => " . $ARGS{$_} . ", ";
+}
+if($ARGS{'UnlockAll'}) {
+ $session{'CurrentUser'}->RemoveLocks;
+ return;
+}
+
+my @locks = $session{'CurrentUser'}->GetLocks;
+my $expiry = RT->Config->Get('LockExpiry');
+</%INIT>
+
+
+<%ARGS>
+$User => $session{'CurrentUser'};
+</%ARGS>
diff --git a/html/Elements/ShowLock b/html/Elements/ShowLock
new file mode 100644
index 0000000..7284328
--- /dev/null
+++ b/html/Elements/ShowLock
@@ -0,0 +1,82 @@
+%# BEGIN LICENSE BLOCK
+%#
+%# Copyright (c) 1996-2002 Jesse Vincent <jesse at bestpractical.com>
+%#
+%# (Except where explictly superceded by other copyright notices)
+%#
+%# 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.
+%#
+%#
+%# Unless otherwise specified, all modifications, corrections or
+%# extensions to this work which alter its source code become the
+%# property of Best Practical Solutions, LLC when submitted for
+%# inclusion in the work.
+%#
+%#
+%# END LICENSE BLOCK
+
+% my $TicketLabel = $Id ? "Ticket #$Id" : 'this ticket';
+
+% if ($Duration ||($u->id && $u->id == $session{'CurrentUser'}->id)) {
+<div class="locked-by-you">
+% if(defined $Duration && !$Lock) {
+ <&|/l, $TicketLabel, $ago &>You had [_1] locked for [_2]. It is now unlocked</&>.
+% #Do not display time if it is very little time, since such a short time probably
+% #means the lock was just created.
+% } elsif($timePassed < 5) {
+ <&|/l, $TicketLabel &>You have locked [_1]</&>.
+% } else {
+ <&|/l, $TicketLabel, $ago &>You have had [_1] locked for [_2]</&>.
+% }
+
+</div>
+% } else {
+% return unless $u->Name;
+% $TicketLabel = 'This ticket' if $TicketLabel eq 'this ticket';
+<div class="locked">
+<&|/l, $TicketLabel, $u->Name, $ago &>[_1] has been locked by [_2] for [_3]</&>.
+</div>
+%}
+<%INIT>
+
+if ( $Id ) {
+ $Ticket = LoadTicket($Id);
+}
+
+my $Lock = $Ticket->Locked() if $Ticket;
+
+return unless (defined $Ticket && defined $Lock) || defined $Duration;
+
+my $timePassed;
+my $date = RT::Date->new($session{'CurrentUser'});
+
+if(defined $Duration) {
+ $timePassed = $Duration;
+}
+elsif($Lock) {
+ $timePassed = time() - $Lock->Content->{'Timestamp'};
+}
+
+my $ago = $date->DurationAsString($timePassed);
+
+my $u = RT::User->new($session{'CurrentUser'});
+$u->Load($Lock->Content->{'User'}) if $Lock;
+
+</%INIT>
+<%ARGS>
+$Ticket => undef
+$Duration => undef
+
+# To enable display of information about a ticket other than the one displayed
+# (e.g., Split shows the Display page for the new ticket, so this allows us to
+# display the Split-from ticket's lock information)
+$Id => 0;
+</%ARGS>
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..9d13686
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,281 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.004;
+use strict 'vars';
+
+use vars qw{$VERSION};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '0.67';
+}
+
+# Whether or not inc::Module::Install is actually loaded, the
+# $INC{inc/Module/Install.pm} is what will still get set as long as
+# the caller loaded module this in the documented manner.
+# If not set, the caller may NOT have loaded the bundled version, and thus
+# they may not have a MI version that works with the Makefile.PL. This would
+# result in false errors or unexpected behaviour. And we don't want that.
+my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+unless ( $INC{$file} ) {
+ die <<"END_DIE";
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+}
+
+# If the script that is loading Module::Install is from the future,
+# then make will detect this and cause it to re-run over and over
+# again. This is bad. Rather than taking action to touch it (which
+# is unreliable on some platforms and requires write permissions)
+# for now we should catch this and refuse to run.
+if ( -f $0 and (stat($0))[9] > time ) {
+ die << "END_DIE";
+Your installer $0 has a modification time in the future.
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+}
+
+use Cwd ();
+use File::Find ();
+use File::Path ();
+use FindBin;
+
+*inc::Module::Install::VERSION = *VERSION;
+ at inc::Module::Install::ISA = __PACKAGE__;
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unshift @_, ($self, $1);
+ goto &{$self->can('call')} unless uc($1) eq $1;
+ };
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+}
+
+sub preload {
+ my ($self) = @_;
+
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ my $admin = $self->{admin};
+ @exts = $admin->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
+ my $in_pod = 0;
+ while ( <PKGFILE> ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ close PKGFILE;
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..81fbcb6
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,70 @@
+#line 1
+package Module::Install::Base;
+
+$VERSION = '0.67';
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+### This is the ONLY module that shouldn't have strict on
+# use strict;
+
+#line 41
+
+sub new {
+ my ($class, %args) = @_;
+
+ foreach my $method ( qw(call load) ) {
+ *{"$class\::$method"} = sub {
+ shift()->_top->$method(@_);
+ } unless defined &{"$class\::$method"};
+ }
+
+ bless( \%args, $class );
+}
+
+#line 61
+
+sub AUTOLOAD {
+ my $self = shift;
+ local $@;
+ my $autoload = eval { $self->_top->autoload } or return;
+ goto &$autoload;
+}
+
+#line 76
+
+sub _top { $_[0]->{_top} }
+
+#line 89
+
+sub admin {
+ $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+}
+
+sub is_admin {
+ $_[0]->admin->VERSION;
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+my $Fake;
+sub new { $Fake ||= bless(\@_, $_[0]) }
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 138
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..5d1eab8
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,82 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Module::Install::Base;
+use Config ();
+### This adds a 5.005 Perl version dependency.
+### This is a bug and will be fixed.
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ my $abs = File::Spec->catfile($dir, $_[1]);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 157
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..e884477
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..fbc5cb2
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,237 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use Module::Install::Base;
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing, always use defaults
+ if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+sub makemaker_args {
+ my $self = shift;
+ my $args = ($self->{makemaker_args} ||= {});
+ %$args = ( %$args, @_ ) if @_;
+ $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = sShift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{name} = defined $args->{$name}
+ ? join( ' ', $args->{name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join(' ', grep length, $clean->{FILES}, @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join(' ', grep length, $realclean->{FILES}, @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+my %test_dir = ();
+
+sub _wanted_t {
+ /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
+}
+
+sub tests_recursive {
+ my $self = shift;
+ if ( $self->tests ) {
+ die "tests_recursive will not work if tests are already defined";
+ }
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ require File::Find;
+ %test_dir = ();
+ File::Find::find( \&_wanted_t, $dir );
+ $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
+ $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} =~ s/-/::/g;
+ if ( $self->tests ) {
+ $args->{test} = { TESTS => $self->tests };
+ }
+ if ($] >= 5.005) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = $self->author;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
+ $args->{NO_META} = 1;
+ }
+ if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+
+ # merge both kinds of requires into prereq_pm
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ }
+ map { @$_ }
+ grep $_,
+ ($self->build_requires, $self->requires)
+ );
+
+ # merge both kinds of requires into prereq_pm
+ my $subdirs = ($args->{DIR} ||= []);
+ if ($self->bundles) {
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($file, $dir) = @$bundle;
+ push @$subdirs, $dir if -d $dir;
+ delete $prereq->{$file};
+ }
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ $args->{INSTALLDIRS} = $self->installdirs;
+
+ my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if (my $preop = $self->admin->preop($user_preop)) {
+ $args{dist} = $preop;
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ my $makefile = do { local $/; <MAKEFILE> };
+ close MAKEFILE or die $!;
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 363
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..b886046
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,336 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+my @scalar_keys = qw{
+ name module_name abstract author version license
+ distribution_type perl_version tests installdirs
+};
+
+my @tuple_keys = qw{
+ build_requires requires recommends bundles
+};
+
+sub Meta { shift }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+
+foreach my $key (@scalar_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} if defined wantarray and !@_;
+ $self->{values}{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key (@tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} unless @_;
+
+ my @rv;
+ while (@_) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ if ( $module eq 'perl' ) {
+ $version =~ s{^(\d+)\.(\d+)\.(\d+)}
+ {$1 + $2/1_000 + $3/1_000_000}e;
+ $self->perl_version($version);
+ next;
+ }
+ my $rv = [ $module, $version ];
+ push @rv, $rv;
+ }
+ push @{ $self->{values}{$key} }, @rv;
+ @rv;
+ };
+}
+
+# configure_requires is currently a null-op
+sub configure_requires { 1 }
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub sign {
+ my $self = shift;
+ return $self->{'values'}{'sign'} if defined wantarray and ! @_;
+ $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
+ return $self;
+}
+
+sub dynamic_config {
+ my $self = shift;
+ unless ( @_ ) {
+ warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
+ return $self;
+ }
+ $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
+ return $self;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name
+ or die "all_from called with no args without setting name() first";
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ die "all_from: cannot find $file from $name" unless -e $file;
+ }
+
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+
+ # The remaining probes read from POD sections; if the file
+ # has an accompanying .pod, use that instead
+ my $pod = $file;
+ if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
+ $file = $pod;
+ }
+
+ $self->author_from($file) unless $self->author;
+ $self->license_from($file) unless $self->license;
+ $self->abstract_from($file) unless $self->abstract;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+
+ # Avoid spurious warnings as we are not checking manifest here.
+
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides(%{ $build->find_dist_packages || {} });
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}{features} ||= [] );
+
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
+ : @$_
+ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}{no_index}{$type} }, @_ if $type;
+ return $self->{values}{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML', 0 );
+
+ require YAML;
+ my $data = YAML::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ }
+ else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ my ( $self, $file ) = @_;
+ require ExtUtils::MM_Unix;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+}
+
+sub abstract_from {
+ my ( $self, $file ) = @_;
+ require ExtUtils::MM_Unix;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+sub _slurp {
+ my ( $self, $file ) = @_;
+
+ local *FH;
+ open FH, "< $file" or die "Cannot open $file.pod: $!";
+ do { local $/; <FH> };
+}
+
+sub perl_version_from {
+ my ( $self, $file ) = @_;
+
+ if (
+ $self->_slurp($file) =~ m/
+ ^
+ use \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ )
+ {
+ my $v = $1;
+ $v =~ s{_}{}g;
+ $self->perl_version($1);
+ }
+ else {
+ warn "Cannot determine perl version info from $file\n";
+ return;
+ }
+}
+
+sub author_from {
+ my ( $self, $file ) = @_;
+ my $content = $self->_slurp($file);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ $self->author($author);
+ }
+ else {
+ warn "Cannot determine author info from $file\n";
+ }
+}
+
+sub license_from {
+ my ( $self, $file ) = @_;
+
+ if (
+ $self->_slurp($file) =~ m/
+ (
+ =head \d \s+
+ (?:licen[cs]e|licensing|copyright|legal)\b
+ .*?
+ )
+ (=head\\d.*|=cut.*|)
+ \z
+ /ixms
+ )
+ {
+ my $license_text = $1;
+ my @phrases = (
+ 'under the same (?:terms|license) as perl itself' => 'perl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser public license' => 'gpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s{\s+}{\\s+}g;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ if ( $osi and $license_text =~ /All rights reserved/i ) {
+ warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
+ }
+ $self->license($license);
+ return 1;
+ }
+ }
+ }
+
+ warn "Cannot determine license info from $file\n";
+ return 'unknown';
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..ae565f4
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,158 @@
+#line 1
+package Module::Install::RTx;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$Module::Install::RTx::VERSION = '0.11';
+
+use strict;
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+sub RTx {
+ my ($self, $name) = @_;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+ $self->version_from (-e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm")
+ unless $self->version;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? (($prefix = $1), 0) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ }
+ else {
+ local @INC = (
+ @INC,
+ $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : (),
+ map {( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )} grep $_, @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to your RT.pm:") or exit;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ print "Using RT configurations from $INC{'RT.pm'}:\n";
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+
+ my %path;
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? (($with_subdirs = $1), 0) : 1 } @ARGV;
+ my %subdirs = map { $_ => 1 } split(/\s*,\s*/, $with_subdirs);
+
+ foreach (qw(bin etc html po sbin var)) {
+ next unless -d "$FindBin::Bin/$_";
+ next if %subdirs and !$subdirs{$_};
+ $self->no_index( directory => $_ );
+
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ my $args = join(', ', map "q($_)", %path);
+ $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
+ print "./$_\t=> $path{$_}\n" for sort keys %path;
+
+ if (my @dirs = map { (-D => $_) } grep $path{$_}, qw(bin html sbin)) {
+ my @po = map { (-o => $_) } grep -f, File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ($path{var} and -d $RT::MasonDataDir) {
+ my ($uid, $gid) = (stat($RT::MasonDataDir))[4, 5];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if (File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*")) {
+ # got schema, load factory module
+ $has_etc{schema}++;
+ $self->load('RTxFactory');
+ $self->postamble(<< ".");
+factory ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+
+dropdb ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+
+.
+ }
+ if (File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*")) {
+ $has_etc{acl}++;
+ }
+ if (-e 'etc/initialdata') {
+ $has_etc{initialdata}++;
+ }
+
+ $self->postamble("$postamble\n");
+ if (%subdirs and !$subdirs{'lib'}) {
+ $self->makemaker_args(
+ PM => { "" => "" },
+ )
+ }
+ else {
+ $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ }
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ }
+}
+
+sub RTxInit {
+ unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+ require RT;
+ RT::LoadConfig();
+ RT::ConnectToDatabase();
+
+ die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+}
+
+1;
+
+__END__
+
+#line 220
+
+#line 241
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..612dc30
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,65 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ if (!$rv) {
+ die <<'END_MESSAGE';
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+ }
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..e1db381
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,43 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base;
+
+use vars qw{$VERSION $ISCORE @ISA};
+BEGIN {
+ $VERSION = '0.67';
+ $ISCORE = 1;
+ @ISA = qw{Module::Install::Base};
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ if ( $0 =~ /Build.PL$/i ) {
+ $self->Build->write;
+ } else {
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{'PL_FILES'} ) {
+ $self->makemaker_args( PL_FILES => {} );
+ }
+ if ($args{inline}) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+ }
+}
+
+1;
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
new file mode 100644
index 0000000..ba8749f
--- /dev/null
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -0,0 +1,175 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
+# <jesse at 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/copyleft/gpl.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::Ticket;
+
+use strict;
+use warnings;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+RT::Extension::TicketLocking - Enables users to place advisory locks on tickets
+
+=cut
+
+our @LockTypes = qw(Auto Hard);
+
+sub Locked {
+ my $ticket = shift;
+ my $lock = $ticket->FirstAttribute('RT_Lock');
+ if($lock) {
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ my $expiry = RT->Config->Get('LockExpiry');
+ if($expiry) {
+ unless($duration < $expiry) {
+ $ticket->DeleteAttribute('RT_Lock');
+ undef $lock;
+ }
+ }
+ }
+ return $lock;
+}
+
+sub Lock {
+ my $ticket = shift;
+ my $type = shift || 'Auto';
+
+ if ( my $lock = $ticket->Locked() ) {
+ return undef if $lock->Content->{'User'} != $ticket->CurrentUser->id;
+ my $LockType = $lock->Content->{'Type'};
+ my $priority;
+ my $LockPriority;
+ for(my $i = 0; $i < scalar @LockTypes; $i++) {
+ $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
+ $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
+ }
+ return undef if $priority <= $LockPriority;
+ }
+ $ticket->Unlock($type); #Remove any existing locks (because this one has greater priority)
+ my $id = $ticket->id;
+ my $username = $ticket->CurrentUser->Name;
+ $ticket->SetAttribute(
+ Name => 'RT_Lock',
+ Description => "$type lock on Ticket $id by user $username",
+ Content => {
+ User => $ticket->CurrentUser->id,
+ Timestamp => time(),
+ Type => $type,
+ Ticket => $id
+ }
+ );
+}
+
+
+sub Unlock {
+ my $ticket = shift;
+ my $type = shift || 'Auto';
+
+ my $lock = $ticket->RT::Ticket::Locked();
+ return (undef, "This ticket was not locked.") unless $lock;
+ return (undef, "You cannot unlock a ticket locked by another user.") unless $lock->Content->{User} == $ticket->CurrentUser->id;
+
+ my $LockType = $lock->Content->{'Type'};
+ my $priority;
+ my $LockPriority;
+ for(my $i = 0; $i < scalar @LockTypes; $i++) {
+ $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
+ $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
+ }
+ return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ $ticket->DeleteAttribute('RT_Lock');
+ return ($duration, "You have unlocked this ticket.");
+}
+
+
+sub BreakLock {
+ my $ticket = shift;
+ return $ticket->DeleteAttribute('RT_Lock');
+}
+
+
+
+
+
+package RT::User;
+
+sub GetLocks {
+ my $self = shift;
+
+ my $attribs = RT::Attributes->new($self);
+ $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
+
+ my $expiry = RT->Config->Get('LockExpiry');
+ return $attribs->Named('RT_Lock') unless $expiry;
+ my @locks;
+
+ foreach my $lock ($attribs->Named('RT_Lock')) {
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ if($duration < $expiry) {
+ push @locks, $lock;
+ }
+ else {
+ $lock->Delete();
+ }
+ }
+ return @locks;
+}
+
+sub RemoveLocks {
+ my $self = shift;
+
+ my $attribs = RT::Attributes->new($self);
+ $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
+ my @attributes = $attribs->Named('RT_Lock');
+ foreach my $lock (@attributes) {
+ $lock->Delete();
+ }
+}
diff --git a/pm_to_blib b/pm_to_blib
new file mode 100644
index 0000000..e69de29
diff --git a/t/rt.t b/t/rt.t
new file mode 100644
index 0000000..f3d4fe1
--- /dev/null
+++ b/t/rt.t
@@ -0,0 +1,30 @@
+#!/usr/bin/perl -w
+use strict;
+
+use Test::More qw/no_plan/;
+use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+use RT::Test;
+my ($baseurl, $m) = RT::Test->started_ok;
+
+diag "Create a ticket" if $ENV{'TEST_VERBOSE'};
+{
+ $m->form_number(3);
+ $m->field('Subject', 'test ticket ' . rand);
+ $m->content =~ qr{<select name="Queue">\s*<option.*?value="(\d+)">\s*General\s*</option>}ms;
+ my $general = $1;
+ diag("General queue: $general");
+ $m->field('Queue', '$general') if $general;
+ $m->click_button(value => 'Create');
+ $m->content =~ qr{<li>Ticket (\d+) created in queue .+</li>};
+ my $id = $1;
+ diag("ID: $id");
+ SKIP: {
+ skip 'No ticket created', 2 unless $id;
+
+ $url .= "/Ticket/Display.html?id=$id";
+ $m->get_ok($url, "Went to ticket display page for ticket $id");
+ open OF, ">/home/toth/test_html/result_content.html" or die;
+ print OF $m->content;
+ $m->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link");
+ }
+}
commit 30946031fdbaf684e8273121680b324b1ad7dd43
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 20:13:11 2007 +0000
* Added an Unlock All link to the My Locks portlet
* Made title bar for the portlet display even if there are no locks, in keeping with the style of the other portlets
diff --git a/html/Elements/MyLocks b/html/Elements/MyLocks
index 4e4eda4..a201e52 100644
--- a/html/Elements/MyLocks
+++ b/html/Elements/MyLocks
@@ -46,9 +46,12 @@
%#
%# END BPS TAGGED BLOCK }}}
+ <&|/Widgets/TitleBox, title => loc("Tickets locked by you") &>
% if(@locks) {
- <&|'/Widgets/TitleBox', title => loc("Tickets locked by you") &>
- <a href="index.html?UnlockAll=1">Unlock all</a>
+ <form action="">
+ <input type='hidden' name='UnlockAll' value='1' />
+ <input type='submit' value='Unlock All' />
+ </form>
<table border="0" cellspacing="0" cellpadding="1" width="100%">
<%PERL>
@@ -82,17 +85,13 @@
}
</%PERL>
</table>
-</&>
%}
+</&>
<%INIT>
-print "ARGS: ";
-foreach(keys %ARGS) {
- print "$_ => " . $ARGS{$_} . ", ";
-}
-if($ARGS{'UnlockAll'}) {
+
+if($m->request_args->{'UnlockAll'}) {
$session{'CurrentUser'}->RemoveLocks;
- return;
}
my @locks = $session{'CurrentUser'}->GetLocks;
commit 3a1a175e8f232d1e4a3ff5ee5d19800b2a2a6e35
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 20:13:20 2007 +0000
* Changed callbacks to use more general names
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessLockArgument
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessLockArgument
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
new file mode 100644
index 0000000..0c821cd
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
@@ -0,0 +1,9 @@
+<%ARGS>
+$Ticket
+$ARGSref => undef
+</%ARGS>
+
+<%INIT>
+my ($d) = $Ticket->Unlock();
+$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessLockArgument b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessLockArgument
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/BeforeActionList
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/ShowLock b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeActionList
similarity index 100%
rename from html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/ShowLock
rename to html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeActionList
commit 9db758b785946e77c3624c2bcdef8cef97d9850e
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 20:13:36 2007 +0000
* Changed Unlock All from a form to a simple link
diff --git a/html/Elements/MyLocks b/html/Elements/MyLocks
index a201e52..7f4aa11 100644
--- a/html/Elements/MyLocks
+++ b/html/Elements/MyLocks
@@ -48,10 +48,7 @@
<&|/Widgets/TitleBox, title => loc("Tickets locked by you") &>
% if(@locks) {
- <form action="">
- <input type='hidden' name='UnlockAll' value='1' />
- <input type='submit' value='Unlock All' />
- </form>
+ <a href="index.html?UnlockAll=1">Unlock All</a>
<table border="0" cellspacing="0" cellpadding="1" width="100%">
<%PERL>
commit 58654fcb44fa4a8b09b3b5b55e837f381f13998c
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 20:27:46 2007 +0000
* Combined callbacks for efficiency
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident
deleted file mode 100644
index 20dad2b..0000000
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/LinkToNewIncident
+++ /dev/null
@@ -1,13 +0,0 @@
-<%ARGS>
-$Child
-$ARGSref
-</%ARGS>
-
-<%INIT>
-# We don't want to bother even trying to lock if the form has been submitted
-# (it will have been locked upon first rendering of the creation page)
-unless($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'}) {
- $Child->Lock();
-}
-$$ARGSref{'Id'} = $$ARGSref{'Child'};
-</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
new file mode 100644
index 0000000..5bcea0e
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
@@ -0,0 +1,24 @@
+<%ARGS>
+$Ticket => undef
+$Child => undef
+$ARGSref => undef
+</%ARGS>
+
+
+<%INIT>
+#Split form has been submitted
+if($Ticket && ($ARGS{'CreateIncident'} || $ARGS {'CreateWithInvestigation'})) {
+ $$ARGSref{'Id'} = $$ARGSref{'Ticket'};
+ my ($d) = $Ticket->Unlock();
+ $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+ return;
+}
+if($Child) {
+ # We don't want to bother even trying to lock if the form has been submitted
+ # (it will have been locked upon first rendering of the creation page)
+ unless($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'}) {
+ $Child->Lock();
+ }
+ $$ARGSref{'Id'} = $$ARGSref{'Child'};
+}
+</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted
deleted file mode 100644
index 8d960cb..0000000
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/SplitSubmitted
+++ /dev/null
@@ -1,10 +0,0 @@
-<%ARGS>
-$Ticket
-$ARGSref
-</%ARGS>
-
-<%INIT>
-$$ARGSref{'Id'} = $$ARGSref{'Ticket'};
-my ($d) = $Ticket->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
-</%INIT>
commit 0725527dd672ce22390dd914ca0f4330e11c170d
Author: Turner Hayes <thayes at bestpractical.com>
Date: Thu Aug 16 22:09:41 2007 +0000
* Fixed bug
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
index 5bcea0e..d7bd7ae 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
@@ -7,7 +7,7 @@ $ARGSref => undef
<%INIT>
#Split form has been submitted
-if($Ticket && ($ARGS{'CreateIncident'} || $ARGS {'CreateWithInvestigation'})) {
+if($Ticket && ($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'})) {
$$ARGSref{'Id'} = $$ARGSref{'Ticket'};
my ($d) = $Ticket->Unlock();
$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
commit 3192ceb4967054c6ccd69e0aba4d115a05544ca7
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 15:08:20 2007 +0000
* Added Id parameter, so that the displayed incident will show "Ticket #XX has been locked for YY sec. It is now unlocked." instead of "This ticket has been..."
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
index 914fb70..f0cdbaf 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
@@ -5,5 +5,6 @@ $ARGSref
<%INIT>
my ($d) = $Child->Unlock('Take');
+$$ARGSref{'Id'} = $Child->id;
$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
</%INIT>
commit f04d4f03a67928e014df24f5a65cfaf820996c46
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 15:47:57 2007 +0000
* Updated README
diff --git a/README b/README
index c6217b5..6b1b329 100644
--- a/README
+++ b/README
@@ -6,6 +6,7 @@ To install this module, run the following commands:
perl Makefile.PL
make
+ make test
make install
@@ -13,7 +14,14 @@ To use this module, you must add the line
use RT::Extension::TicketLocking;
-to the bottom of your RT_SiteConfig.pm file.
+to the bottom of your RT_SiteConfig.pm file. You must also define a lock expiry (the longest time
+a lock can remain without being automatically removed, by adding a line like the following to your
+RT_SiteConfig.pm file:
+
+ Set($LockExpiry, 300);
+
+Expiration time is measured in seconds. If you don't wish to have your locks automatically expire,
+simply set $LockExpiry to a false value.
If you want the MyLocks portlet to be available from the RT at a Glance page, you will need to
commit 6bb49c16110e88524956323c5fb2d9bd26725ff8
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 20:27:20 2007 +0000
* Added hack to get around the redirect in /Ticket/Display.html nuking all variables except id
diff --git a/blib/lib/RT/Extension/TicketLocking.pm b/blib/lib/RT/Extension/TicketLocking.pm
index ba8749f..ac6e147 100644
--- a/blib/lib/RT/Extension/TicketLocking.pm
+++ b/blib/lib/RT/Extension/TicketLocking.pm
@@ -126,7 +126,7 @@ sub Unlock {
return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
my $duration = time() - $lock->Content->{'Timestamp'};
$ticket->DeleteAttribute('RT_Lock');
- return ($duration, "You have unlocked this ticket.");
+ return ($duration, "You have unlocked this ticket. It was locked for $duration seconds.");
}
diff --git a/blib/man3/RT::Extension::TicketLocking.3pm b/blib/man3/RT::Extension::TicketLocking.3pm
index 2da3895..09676c7 100644
--- a/blib/man3/RT::Extension::TicketLocking.3pm
+++ b/blib/man3/RT::Extension::TicketLocking.3pm
@@ -129,6 +129,6 @@
.\" ========================================================================
.\"
.IX Title "RT::Extension::TicketLocking 3pm"
-.TH RT::Extension::TicketLocking 3pm "2007-08-14" "perl v5.8.8" "User Contributed Perl Documentation"
+.TH RT::Extension::TicketLocking 3pm "2007-08-17" "perl v5.8.8" "User Contributed Perl Documentation"
.SH "NAME"
RT::Extension::TicketLocking \- Enables users to place advisory locks on tickets
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
index c153e18..1766f18 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
@@ -1,4 +1,17 @@
+<%ARGS>
+$Duration => undef
+$Actions => undef
+</%ARGS>
+
<%INIT>
+#A somewhat inelegant hack to get around /Ticket/Display.html's redirect, which nukes all
+#variables except for id
+unless($Duration) {
+ my @msg = grep(qr{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions);
+ my $msg = pop @msg;
+ $msg =~ /(You have unlocked this ticket\.) It was locked for (\d+) seconds\./i;
+ $ARGS{'Duration'} = $2 if $2;
+}
$m->comp('/Elements/ShowLock', %ARGS);
return;
</%INIT>
diff --git a/html/Elements/ShowLock b/html/Elements/ShowLock
index 7284328..872f104 100644
--- a/html/Elements/ShowLock
+++ b/html/Elements/ShowLock
@@ -46,7 +46,7 @@
</div>
%}
<%INIT>
-
+grep {$_ =~ s/(You have unlocked this ticket\.) It was locked for \d+ seconds\./$1/i} @{$ARGS{'Actions'}} if $ARGS{'Actions'};
if ( $Id ) {
$Ticket = LoadTicket($Id);
}
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index ba8749f..ac6e147 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -126,7 +126,7 @@ sub Unlock {
return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
my $duration = time() - $lock->Content->{'Timestamp'};
$ticket->DeleteAttribute('RT_Lock');
- return ($duration, "You have unlocked this ticket.");
+ return ($duration, "You have unlocked this ticket. It was locked for $duration seconds.");
}
commit ff8f08104273274a8c92f26177b4c5de9971bdeb
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 21:06:31 2007 +0000
* Added some testing facilities
* Moved locking documentation from RT
diff --git a/docs/locking b/docs/locking
new file mode 100644
index 0000000..f18a806
--- /dev/null
+++ b/docs/locking
@@ -0,0 +1,82 @@
+RT Locking
+----------
+
+- Locks can be of several different types. Current types are:
+ - Hard (manual lock)
+ - Take (results from Taking an Incident Report, removed when linked to an Incident)
+ - This is only applicable within RTIR. If RTIR is not installed, this type will not
+ be available.
+ - Auto (default type, results from going to certain pages listed below)
+
+- Each type is associated with a priority. Current priorities are as follows, from highest priority to lowest:
+ - Hard
+ - Take
+ - Auto
+
+- A lock can be initiated manually by clicking the "Lock" link on one of the pages for the ticket (hard lock)
+
+- A lock is created whenever a user performs an action on a ticket that takes multiple steps (auto lock) if a
+ hard lock is not already in place for that ticket
+
+ Locking Actions in RT:
+ ----------------------
+
+ - Comment
+ - Reply
+ - Resolve
+
+
+ Locking Actions in RTIR:
+ ------------------------
+
+ - Edit
+ - Split
+ - Merge
+ - Advanced
+ - Reply
+ - Resolve
+ - Reject
+ - Comment
+ - Remove
+
+- A lock can be removed manually by clicking the "Unlock" link on one of the pages for the ticket (hard unlock)
+
+- An auto lock is removed once the user is done with whatever he was doing on the page (e.g., when he clicks
+ "Save Changes" on the Edit page). It is also removed if the Unlock link is clicked from a page that generated
+ an auto lock. Clicking "Unlock" will also remove the hard lock on the ticket, if there is one.
+
+- Locks are advisory: if a ticket is locked by one user, other users will be given a notification (in red) that another user has locked the ticket but they will still be allowed to edit and submit changes on the ticket.
+
+- Locks will remain in place until
+ a) The user is done editing/replying/etc. (for auto locks, if there is no hard lock on the ticket)
+ b) The user clicks the Unlock link
+ c) The user logs out
+ d) A configurable expiry period has elapsed
+
+- When a user clicks the "Take" link for an RTIR Incident ticket, a Take lock is added. This lock will only be removed
+ when the Incident is linked to a new or existing Investigation.
+
+- When a user locks a ticket (auto lock or hard lock), they are given a notification informing them of their lock (in some other color--currently green).
+
+- When a user unlocks a ticket (auto unlock or hard unlock), they are given a notification informing them that their
+ lock has been removed, and how long they had the ticket locked for.
+
+- When a user accesses a page for a ticket that they have locked, they are presented with a notification informing them
+ that they have the ticket locked, and how long they have had the ticket locked.
+
+- When a user accesses a page for a ticket that has been locked by another user, they are given a notification of the
+ other user's lock, with the locking user's name and how long they have had it locked for.
+
+- When a locked ticket (hard or Take lock) is merged into another ticket, the ticket being merged into will get the lock
+ type of the ticket being merged from. This lock shift is conditional upon priority, as usual--if the merged from
+ ticket has a lock of a lower priority than the merged-to ticket, the merged-to ticket will retain its lock. If the
+ merged-to ticket is locked by a different user, that user will retain the lock. Basically, the merged-to ticket will
+ retain its lock if it is higher priority than the lock on the ticket being merged from.
+
+
+
+-----------
+Optional frills
+-----------
+
+Lock display portlet for homepage (display all of your locks)
diff --git a/t/rt.t b/t/rt.t
index f3d4fe1..acd81d5 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -1,30 +1,30 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
+
use strict;
+use warnings;
+
-use Test::More qw/no_plan/;
use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
-use RT::Test;
-my ($baseurl, $m) = RT::Test->started_ok;
-
-diag "Create a ticket" if $ENV{'TEST_VERBOSE'};
-{
- $m->form_number(3);
- $m->field('Subject', 'test ticket ' . rand);
- $m->content =~ qr{<select name="Queue">\s*<option.*?value="(\d+)">\s*General\s*</option>}ms;
- my $general = $1;
- diag("General queue: $general");
- $m->field('Queue', '$general') if $general;
- $m->click_button(value => 'Create');
- $m->content =~ qr{<li>Ticket (\d+) created in queue .+</li>};
- my $id = $1;
- diag("ID: $id");
- SKIP: {
- skip 'No ticket created', 2 unless $id;
-
- $url .= "/Ticket/Display.html?id=$id";
- $m->get_ok($url, "Went to ticket display page for ticket $id");
- open OF, ">/home/toth/test_html/result_content.html" or die;
- print OF $m->content;
- $m->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link");
- }
-}
+
+use Test::More qw/no_plan/;
+
+use HTTP::Cookies;
+
+require "t/test_suite.pl";
+
+my $agent = default_agent();
+
+my $root = new RT::Test::Web;
+$root->cookie_jar( HTTP::Cookies->new );
+$root->login('root', 'password');
+
+my $SUBJECT = "foo " . rand;
+
+my $id = create_ticket($agent, 'General', {Subject => $SUBJECT});
+my $ticket = RT::Ticket->new(RT::SystemUser());
+$ticket->Load($id);
+
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on Ticket $id");
+my $lock = $ticket->Locked();
+ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
diff --git a/t/rtir.t b/t/rtir.t
new file mode 100644
index 0000000..257f0ea
--- /dev/null
+++ b/t/rtir.t
@@ -0,0 +1,376 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+
+use Test::More;
+
+eval 'use RT::IR; 1' or plan skip_all => 'RTIR not installed';
+
+plan tests => 117;
+
+use HTTP::Cookies;
+
+require "t/test_suite.pl";
+
+my $agent = default_agent();
+
+my $root = new RT::Test::Web;
+$root->cookie_jar( HTTP::Cookies->new );
+$root->login('root', 'password');
+
+my $SUBJECT = "foo " . rand;
+
+
+
+diag("Testing Incident locking") if $ENV{'TEST_VERBOSE'};
+# Create an incident
+my $inc = create_incident($agent, {Subject => $SUBJECT, Content => "bla", Owner => 'Nobody in particular (Nobody)' });
+
+
+my $inc_obj = RT::Ticket->new(RT::SystemUser());
+
+$inc_obj->Load($inc);
+is($inc_obj->Id, $inc, "report has right ID");
+is($inc_obj->Subject, $SUBJECT, "subject is right");
+
+#Hard lock
+diag("Testing hard lock") if $ENV{'TEST_VERBOSE'};
+
+$agent->goto_ticket($inc);
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on ticket $inc");
+my $lock = $inc_obj->Locked();
+ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
+
+###Testing lock expiration###
+###Be sure to set LockExpiry to a short time (say, 30) in RT_SiteConfig.pm, or you'll be waiting
+###for a while for this test to finish###
+
+my $expire = RT->Config->Get('LockExpiry');
+
+SKIP: {
+ skip 'Not testing lock expiry--expiration feature turned off', 4 unless $expire;
+ sleep $expire;
+
+ $agent->follow_link_ok({text => 'Display', n =>'1'}, "Going back to display page for Incident #$inc");
+ $agent->content_unlike(qr{<div class="locked-by-you">}, "Incident #$inc not locked anymore (lock expired)");
+ ok(!$inc_obj->Locked(), "Lock not in the database");
+
+
+ $agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link again");
+}
+
+sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
+
+
+###Testing Reply.html locking###
+
+$agent->follow_link_ok({text => 'Reply to Reporters', n => '1'}, "Followed Reply to Reporters link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Reply to Reporters page is locked");
+$agent->form_number(3);
+$agent->click('SubmitTicket');
+diag("Submitted Reply form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">}, "Incident $inc is still locked");
+
+
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Edit page is locked");
+
+$agent->form_number(3);
+$agent->submit();
+diag("Submitted Edit form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">}, "Incident $inc is still locked");
+
+$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Unlocking Incident $inc");
+$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "Incident $inc is not locked");
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link again");
+sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
+$agent->follow_link_ok({text => 'Split', n => '1'}, "Followed Split link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Split page is still locked");
+$agent->form_number(3);
+my $nobody;
+if($agent->content =~ qr{<option.+?value="(\d+)"\s*>Nobody in particular (Nobody)</option>}ims) {
+ $nobody = $1;
+ $agent->field('Owner', $nobody);
+}
+$agent->click('CreateIncident');
+diag("Submitted Split form") if $ENV{'TEST_VERBOSE'};
+my $inc_id2;
+if($agent->content =~ qr{<li>Ticket (\d+) created in queue.*</li>}i) {
+ $inc_id2 = $1;
+}
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had Ticket #$inc locked for \d+ \w+\.\W+</div>}ims, "Incident $inc is still locked");
+display_ticket($agent, $inc);
+$agent->follow_link_ok({text => 'Merge', n => '1'}, "Followed Merge link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Merge page is still locked");
+$agent->form_number(3);
+
+$agent->field("SelectedTicket", $inc_id2);
+$agent->submit();
+diag("Submitted Merge form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Lock from $inc moved to $inc_id2");
+$inc = $inc_id2;
+$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Removing hard lock on Incident $inc");
+
+
+#Auto lock
+diag("Testing auto lock") if $ENV{'TEST_VERBOSE'};
+
+
+###Testing Reply.html locking###
+
+$agent->follow_link_ok({text => 'Reply to Reporters', n => '1'}, "Followed Reply to Reporters link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Reply to Reporters page is locked");
+sleep 5;
+$agent->form_number(3);
+$agent->click('SubmitTicket');
+diag("Submitted Reply form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "Incident $inc is still locked");
+
+
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket}ims, "Edit page is auto locked");
+# Without this, the lock type doesn't seem to refresh, even on successive calls to Locked()
+$inc_obj->Load($inc);
+$lock = $inc_obj->Locked();
+ok(($lock->Content->{'Type'} eq 'Auto'), "Lock is an Auto lock");
+$agent->form_number(3);
+$agent->submit();
+diag("Submitted Edit form") if $ENV{'TEST_VERBOSE'};
+$agent->content_unlike(qr{<div class="locked-by-you">.+\.It is now unlocked\.}ims, "Incident $inc is not locked");
+
+$agent->follow_link_ok({text => 'Split', n => '1'}, "Followed Split link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket}ims, "Split page is auto locked");
+$agent->form_number(3);
+$agent->field('Owner', $nobody);
+sleep 5;
+$agent->click('CreateIncident');
+diag("Submitted Split form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You had Ticket #$inc locked for \d+ \w+. It is now unlocked\.}ims, "Incident $inc is not locked");
+if($agent->content =~ qr{<li>Ticket (\d+) created in queue.*</li>}i) {
+ $inc_id2 = $1;
+}
+display_ticket($agent, $inc);
+$agent->follow_link_ok({text => 'Merge', n => '1'}, "Followed Merge link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Merge page is locked");
+$agent->form_number(3);
+
+$agent->field("SelectedTicket", $inc_id2);
+$agent->submit();
+diag("Submitted Merge form") if $ENV{'TEST_VERBOSE'};
+$agent->content_unlike(qr{<div class="locked-by-you">}ims, "Lock from $inc not moved to $inc_id2");
+$inc = $inc_id2;
+
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Hard locked to test multi-user lock");
+
+
+
+diag("Testing Incident locking from other user's point of view");
+
+display_ticket($root, $inc);
+$root->content_like(qr{<div class="locked">}, "Incident #$inc is locked by another");
+$root->follow_link_ok({text => 'Break lock', n => '1'}, "Breaking lock on Incident #$inc");
+$root->content_like(qr{<li>You have broken the lock on this ticket</li>}, "Lock on Incident #$inc is broken");
+
+
+diag("Testing Incident Report locking") if $ENV{'TEST_VERBOSE'};
+# Create a report
+my $report = create_ir($agent, {Subject => $SUBJECT, Content => "bla", Owner => 'Nobody in particular (Nobody)' });
+
+
+
+my $ir_obj = RT::Ticket->new(RT::SystemUser());
+
+$ir_obj->Load($report);
+is($ir_obj->Id, $report, "report has right ID");
+is($ir_obj->Subject, $SUBJECT, "subject is right");
+
+#Hard lock
+diag("Testing hard lock") if $ENV{'TEST_VERBOSE'};
+
+$agent->goto_ticket($report);
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on ticket $report");
+$lock = $ir_obj->Locked();
+ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
+
+sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
+
+###Testing Update.html locking###
+
+$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Comment page is locked");
+$agent->form_number(3);
+$agent->submit();
+diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">}, "IR $report is still locked");
+
+###Testing Edit.html locking###
+
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Edit page is locked");
+$agent->form_number(3);
+$agent->submit();
+diag("Submitted Edit form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">}, "IR $report is still locked");
+
+$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Unlocking IR $report");
+$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "IR $report is not locked");
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link again");
+sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
+
+
+###Testing Split.html locking###
+
+$agent->follow_link_ok({text => 'Split', n => '1'}, "Followed Split link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Split page is still locked");
+$agent->form_number(3);
+$agent->field('Owner', $nobody);
+$agent->click('Create');
+diag("Submitted Split form") if $ENV{'TEST_VERBOSE'};
+my $ir_id2;
+if($agent->content =~ qr{<li>Ticket (\d+) created in queue.*</li>}i) {
+ $ir_id2 = $1;
+}
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had Ticket #$report locked for \d+ \w+\.\W+</div>}ims, "IR $report is still locked");
+
+###Testing Merge.html locking###
+
+display_ticket($agent, $report);
+$agent->follow_link_ok({text => 'Merge', n => '1'}, "Followed Merge link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+}ims, "Merge page is still locked");
+$agent->form_number(3);
+
+$agent->field("SelectedTicket", $ir_id2);
+$agent->submit();
+diag("Submitted Merge form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Lock from $report moved to $ir_id2");
+$report = $ir_id2;
+$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Removing hard lock on IR $report");
+
+
+#Auto lock
+diag("Testing auto lock") if $ENV{'TEST_VERBOSE'};
+
+###Testing Update.html locking###
+
+$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket}ims, "Comment page is auto locked");
+# Without this, the lock type doesn't seem to refresh, even on successive calls to Locked()
+$ir_obj->Load($report);
+$lock = $ir_obj->Locked();
+ok(($lock->Content->{'Type'} eq 'Auto'), "Lock is an Auto lock");
+sleep 5;
+$agent->form_number(3);
+$agent->click('SubmitTicket');
+diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">.+\. It is now unlocked\.}ims, "IR $report is still locked");
+
+
+###Testing Edit.html locking###
+
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket}ims, "Edit page is auto locked");
+$agent->form_number(3);
+sleep 5;
+$agent->click('SaveChanges');
+diag("Submitted Edit form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">.+\. It is now unlocked\.}ims, "IR $report is not locked");
+
+$agent->follow_link_ok({text => 'Split', n => '1'}, "Followed Split link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket}ims, "Split page is auto locked");
+$agent->form_number(3);
+sleep 5;
+$agent->click('Create');
+diag("Submitted Split form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You had Ticket #$report locked for \d+ \w+. It is now unlocked\.}ims, "IR $report is not locked");
+if($agent->content =~ qr{<li>Ticket (\d+) created in queue.*</li>}i) {
+ $ir_id2 = $1;
+}
+display_ticket($agent, $report);
+$agent->follow_link_ok({text => 'Merge', n => '1'}, "Followed Merge link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Merge page is locked");
+$agent->form_number(3);
+
+$agent->field("SelectedTicket", $ir_id2);
+$agent->submit();
+diag("Submitted Merge form") if $ENV{'TEST_VERBOSE'};
+$agent->content_unlike(qr{<div class="locked-by-you">}ims, "Lock from $report not moved to $ir_id2");
+$report = $ir_id2;
+
+#Now we need to set the owner to Nobody so that we can take the ticket for the Take tests
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+$agent->form_number(3);
+$agent->field('Owner', $nobody);
+$agent->click('SaveChanges');
+$agent->content_like(qr{<li>Owner changed from \w+ to Nobody</li>}, "Owner changed to Nobody");
+
+
+
+#Take lock
+diag("Testing take lock") if $ENV{'TEST_VERBOSE'};
+$agent->follow_link_ok({text => 'Take', n => '1'}, "Followed Take link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Got a lock from Taking");
+$ir_obj->Load($report);
+$lock = $ir_obj->Locked();
+ok(($lock->Content->{'Type'} eq 'Take'), "Lock is a Take lock");
+sleep 5;
+$agent->follow_link_ok({text => '[New]', n => '1'}, "Followed New (incident to link to) link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had Ticket #$report locked for \d+ \w+\.}, "IR #$report is locked on Create Incident page");
+$agent->form_number(3);
+$agent->field('Subject', 'Incident linked to Lock Testing IR');
+$agent->click('CreateIncident');
+$agent->content_like(qr{<div class="locked-by-you">\s*You had Ticket #$report locked for \d+ \w+. It is now unlocked\.}ims, "Removed IR #$report Take lock");
+$agent->goto_ticket($report);
+$agent->content_unlike(qr{<div class="locked-by-you">}ims, "IR #$report is not locked");
+
+###Testing linking to existing incident###
+$agent->follow_link_ok({text => '[Unlink]', n => '1'}, "Followed Unlink link");
+$agent->follow_link_ok({text => 'Edit', n => '1'}, "Followed Edit link");
+$agent->form_number(3);
+$agent->field('Owner', $nobody);
+$agent->click('SaveChanges');
+$agent->content_like(qr{<li>Owner changed from \w+ to Nobody</li>}, "Owner changed to Nobody");
+$agent->follow_link_ok({text => 'Take', n => '1'}, "Followed Take link again");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Got a lock from Taking");
+sleep 5;
+$agent->follow_link_ok({text => '[Link]', n => '1'}, "Followed Link (to existing incident) link");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.}, "IR still locked on Link To Incident page");
+###Pick a ticket to link to (we don't really care which)
+$agent->content =~ qr{<input type="radio" name="SelectedTicket" value="(\d+)"\s*/>}ims;
+my $inc_to_link_to = $1;
+$agent->form_number(3);
+$agent->field('SelectedTicket', $inc_to_link_to);
+$agent->click('LinkChild');
+$agent->content_like(qr{<div class="locked-by-you">\s*You had Ticket #$report locked for \d+ \w+. It is now unlocked\.}ims, "Removed IR #$report Take lock");
+
+$agent->goto_ticket($report);
+$agent->follow_link_ok({text => 'Lock', n => '1'}, "Hard locked to test multi-user lock");
+
+
+
+
+diag("Testing IR locking from other user's point of view");
+
+go_home($root);
+display_ticket($root, $report);
+$root->content_like(qr{<div class="locked">}, "IR #$report is locked by another");
+$root->follow_link_ok({text => 'Break lock', n => '1'}, "Breaking lock on IR #$report");
+$root->content_like(qr{<li>You have broken the lock on this ticket</li>}, "Lock on IR #$report is broken");
+
+
+
+
+
+
+#removes all user's locks
+$agent->follow_link_ok({text => 'Logout', n => '1'}, "Logging out rtir_test_user");
+$root->follow_link_ok({text => 'Logout', n => '1'}, "Logging out root");
+
+1;
diff --git a/t/test_suite.pl b/t/test_suite.pl
new file mode 100644
index 0000000..6aa3e99
--- /dev/null
+++ b/t/test_suite.pl
@@ -0,0 +1,317 @@
+#!/usr/bin/perl
+
+# Load this in test scripts with: require "t/test_suite.pl";
+# *AFTER* loading in Test::More.
+
+
+use strict;
+use warnings;
+
+use HTTP::Cookies;
+use Test::More;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+
+use RT;
+RT::LoadConfig();
+RT::Init();
+
+my $RTIR_TEST_USER = "rtir_test_user";
+my $RTIR_TEST_PASS = "rtir_test_pass";
+
+require RT::Test;
+use RT::Test::Web;
+
+sub default_agent {
+ my $agent = new RT::Test::Web;
+ $agent->cookie_jar( HTTP::Cookies->new );
+ $agent->login($RTIR_TEST_USER, $RTIR_TEST_PASS);
+ go_home($agent);
+ return $agent;
+}
+
+sub set_custom_field {
+ my $agent = shift;
+ my $cf_name = shift;
+ my $val = shift;
+ my $field_name = $agent->value($cf_name) or return 0;
+ $agent->field($field_name, $val);
+ return 1;
+}
+
+sub go_home {
+ my $agent = shift;
+ my $weburl = RT->Config->Get('WebURL');
+ $agent->get_ok("$weburl/RTIR/index.html", "Loaded home page");
+}
+
+sub display_ticket {
+ my $agent = shift;
+ my $id = shift;
+
+ $agent->get_ok(RT->Config->Get('WebURL') . "/RTIR/Display.html?id=$id", "Loaded Display page for Ticket #$id");
+}
+
+sub ticket_state_is {
+ my $agent = shift;
+ my $id = shift;
+ my $state = shift;
+ my $desc = shift || "State of the ticket #$id is '$state'";
+ display_ticket( $agent, $id );
+ $agent->content =~ qr{State:\s*</td>\s*<td[^>]*?>\s*<span class="cf-value">([\w ]+)</span>}ism;
+ return is($1, $state, $desc);
+}
+
+
+sub create_user {
+ my $user_obj = rtir_user();
+
+ ok($user_obj->Id > 0, "Successfully found the user");
+
+ my $group_obj = RT::Group->new(RT::SystemUser());
+ $group_obj->LoadUserDefinedGroup("DutyTeam");
+ ok($group_obj->Id > 0, "Successfully found the DutyTeam group");
+
+ $group_obj->AddMember($user_obj->Id);
+ ok($group_obj->HasMember($user_obj->PrincipalObj), "user is in the group");
+}
+
+sub rtir_user {
+ my $u = RT::Test->load_or_create_user(
+ Name => $RTIR_TEST_USER,
+ Password => $RTIR_TEST_PASS,
+ EmailAddress => "$RTIR_TEST_USER\@example.com",
+ RealName => "$RTIR_TEST_USER Smith",
+ Privileged => 1,
+ );
+ return $u;
+}
+
+sub create_incident {
+ return create_rtir_ticket_ok( shift, 'Incidents', @_ );
+}
+sub create_ir {
+ return create_rtir_ticket_ok( shift, 'Incident Reports', @_ );
+}
+sub create_investigation {
+ return create_rtir_ticket_ok( shift, 'Investigations', @_ );
+}
+sub create_block {
+ return create_rtir_ticket_ok( shift, 'Blocks', @_ );
+}
+
+sub goto_create_rtir_ticket {
+ my $agent = shift;
+ my $queue = shift;
+
+ my %type = (
+ 'Incident Reports' => 'Report',
+ 'Investigations' => 'Investigation',
+ 'Blocks' => 'Block',
+ 'Incidents' => 'Incident'
+ );
+
+ go_home($agent);
+
+ $agent->follow_link_ok({text => $queue, n => "1"}, "Followed '$queue' link");
+ $agent->follow_link_ok({text => "New ". $type{ $queue }, n => "1"}, "Followed 'New $type{$queue}' link");
+
+
+ # set the form
+ $agent->form_number(3);
+}
+
+sub create_rtir_ticket_ok {
+ my $agent = shift;
+ my $queue = shift;
+
+ my $id = create_rtir_ticket( $agent, $queue, @_ );
+ ok $id, "Created ticket #$id in queue '$queue' successfully.";
+ return $id;
+}
+
+sub create_rtir_ticket
+{
+ my $agent = shift;
+ my $queue = shift;
+ my $fields = shift || {};
+ my $cfs = shift || {};
+
+ goto_create_rtir_ticket($agent, $queue);
+
+ #Enable test scripts to pass in the name of the owner rather than the ID
+ if ($$fields{Owner} && $$fields{Owner} !~ /^\d+$/)
+ {
+ if($agent->content =~ qr{<option.+?value="(\d+)"\s*>$$fields{Owner}</option>}ims) {
+ $$fields{Owner} = $1;
+ }
+ }
+
+
+ $fields->{'Requestors'} ||= $RTIR_TEST_USER if $queue eq 'Investigations';
+ while (my ($f, $v) = each %$fields) {
+ $agent->field($f, $v);
+ }
+
+ while (my ($f, $v) = each %$cfs) {
+ set_custom_field($agent, $f, $v);
+ }
+
+ my %create = (
+ 'Incident Reports' => 'Create',
+ 'Investigations' => 'Create',
+ 'Blocks' => 'Create',
+ 'Incidents' => 'CreateIncident'
+ );
+ # Create it!
+ $agent->click( $create{ $queue } );
+
+ is ($agent->status, 200, "Attempted to create the ticket");
+
+ return get_ticket_id($agent);
+}
+
+sub get_ticket_id {
+ my $agent = shift;
+ my $content = $agent->content();
+ my $id = 0;
+ if ($content =~ /.*Ticket (\d+) created.*/g) {
+ $id = $1;
+ }
+ elsif ($content =~ /.*No permission to view newly created ticket #(\d+).*/g) {
+ diag("\nNo permissions to view the ticket.\n") if($ENV{'TEST_VERBOSE'});
+ }
+ return $id;
+}
+
+
+sub create_incident_for_ir {
+ my $agent = shift;
+ my $ir_id = shift;
+ my $fields = shift || {};
+ my $cfs = shift || {};
+
+ display_ticket($agent, $ir_id);
+
+ # Select the "New" link from the Display page
+ $agent->follow_link_ok({text => "[New]"}, "Followed 'New (Incident)' link");
+
+ $agent->form_number(3);
+
+ while (my ($f, $v) = each %$fields) {
+ $agent->field($f, $v);
+ }
+
+ while (my ($f, $v) = each %$cfs) {
+ set_custom_field($agent, $f, $v);
+ }
+
+ $agent->click("CreateIncident");
+
+ is ($agent->status, 200, "Attempting to create new incident linked to child $ir_id");
+
+ ok ($agent->content =~ /.*Ticket (\d+) created in queue.*/g, "Incident created from child $ir_id.");
+ my $incident_id = $1;
+
+# diag("incident ID is $incident_id");
+ return $incident_id;
+}
+
+sub ok_and_content_like {
+ my $agent = shift;
+ my $re = shift;
+ my $desc = shift || "looks good";
+
+ is($agent->status, 200, "request successful");
+ #like($agent->content, $re, $desc);
+ $agent->content_like($re, $desc);
+}
+
+
+sub create_incident_and_investigation {
+ my $agent = shift;
+ my $fields = shift || {};
+ my $cfs = shift || {};
+ my $ir_id = shift;
+
+ $ir_id ? display_ticket($agent, $ir_id) : go_home($agent);
+
+ if($ir_id) {
+ # Select the "New" link from the Display page
+ $agent->follow_link_ok({text => "[New]"}, "Followed 'New (Incident)' link");
+ }
+ else
+ {
+ $agent->follow_link_ok({text => "Incidents"}, "Followed 'Incidents' link");
+ $agent->follow_link_ok({text => "New Incident", n => '1'}, "Followed 'New Incident' link");
+ }
+
+ # Fill out forms
+ $agent->form_number(3);
+
+ while (my ($f, $v) = each %$fields) {
+ $agent->field($f, $v);
+ }
+
+ while (my ($f, $v) = each %$cfs) {
+ set_custom_field($agent, $f, $v);
+ }
+ $agent->click("CreateWithInvestigation");
+ my $msg = $ir_id
+ ? "Attempting to create new incident and investigation linked to child $ir_id"
+ : "Attempting to create new incident and investigation";
+ is ($agent->status, 200, $msg);
+ $msg = $ir_id ? "Incident created from child $ir_id." : "Incident created.";
+
+ my $re = qr/.*Ticket (\d+) created in queue 'Incidents'/;
+ $agent->content_like( $re, $msg );
+ my ($incident_id) = ($agent->content =~ $re);
+
+ $re = qr/.*Ticket (\d+) created in queue 'Investigations'/;
+ $agent->content_like( $re, "Investigation created for Incident $incident_id." );
+ my ($investigation_id) = ($agent->content =~ $re);
+
+ return ($incident_id, $investigation_id);
+}
+
+
+sub create_ticket {
+ my $agent = shift;
+ my $queue = shift || 'General';
+
+ return create_rtir_ticket($agent, $queue, @_) if $queue eq 'Incidents' || $queue eq 'Blocks' || $queue eq 'Investigations' || $queue eq 'Incident Reports';
+
+ my $fields = shift || {};
+ my $cfs = shift || {};
+
+ $agent->get_ok("${RT::WebPath}/Ticket/Create.html?Queue=$queue", "Went to Create page in queue $queue");
+ diag("We are at " . $agent->uri);
+ #Enable test scripts to pass in the name of the owner rather than the ID
+ if ($$fields{Owner} && $$fields{Owner} !~ /^\d+$/)
+ {
+ if($agent->content =~ qr{<option.+?value="(\d+)"\s*>$$fields{Owner}</option>}ims) {
+ $$fields{Owner} = $1;
+ }
+ }
+
+ $agent->form_number(3);
+ $fields->{'Requestors'} ||= $RTIR_TEST_USER if $queue eq 'Investigations';
+ while (my ($f, $v) = each %$fields) {
+ $agent->field($f, $v);
+ }
+
+ while (my ($f, $v) = each %$cfs) {
+ set_custom_field($agent, $f, $v);
+ }
+
+
+ # Create it!
+ $agent->click_button(value => 'Create');
+
+ is ($agent->status, 200, "Attempted to create the ticket");
+
+ return get_ticket_id($agent);
+}
+
+1;
commit bd909847747f1b8aff636a21f1ccdb9598873040
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 21:43:11 2007 +0000
* Fixed bug (for some reason, a decimal number would sometimes be found)
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
index 1766f18..dee0d95 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
@@ -10,7 +10,7 @@ unless($Duration) {
my @msg = grep(qr{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions);
my $msg = pop @msg;
$msg =~ /(You have unlocked this ticket\.) It was locked for (\d+) seconds\./i;
- $ARGS{'Duration'} = $2 if $2;
+ $ARGS{'Duration'} = $2 if $2 && $2 !~ /\./;
}
$m->comp('/Elements/ShowLock', %ARGS);
return;
commit 3121b7e084f29e30bd4f2d81561128fd3507ef97
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 21:43:17 2007 +0000
* Added tests to make sure lock is shown on all core RT pages for a given ticket
diff --git a/t/rt.t b/t/rt.t
index acd81d5..713baff 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -28,3 +28,38 @@ $agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link for Ticke
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on Ticket $id");
my $lock = $ticket->Locked();
ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
+sleep 5;
+###Testing that the lock stays###
+
+$agent->follow_link_ok({text => 'History', n => '1'}, "Followed History link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on History page");
+
+$agent->follow_link_ok({text => 'Basics', n => '1'}, "Followed Basics link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Basics page");
+
+$agent->follow_link_ok({text => 'Dates', n => '1'}, "Followed Dates link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Dates page");
+
+$agent->follow_link_ok({text => 'People', n => '1'}, "Followed People link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on People page");
+
+$agent->follow_link_ok({text => 'Links', n => '1'}, "Followed Links link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Links page");
+
+$agent->follow_link_ok({text => 'Reminders', n => '1'}, "Followed Reminders link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Reminders page");
+
+$agent->follow_link_ok({text => 'Jumbo', n => '1'}, "Followed Jumbo link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Jumbo page");
+
+$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Comment page");
+$agent->form_number(3);
+$agent->click('SubmitTicket');
+diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked after submitting comment");
+
+
+
+#removes all user's locks
+$agent->follow_link_ok({text => 'Logout', n => '1'}, "Logging out rtir_test_user");
commit 71b2bd09b4700746ba42a240d9cc4a83ed4ebaa0
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 22:23:32 2007 +0000
* Updated documentation
* Updated testing RT core (1 failing test)
* Updated TicketLocking test suite
diff --git a/docs/locking b/docs/locking
index f18a806..5170484 100644
--- a/docs/locking
+++ b/docs/locking
@@ -10,7 +10,7 @@ RT Locking
- Each type is associated with a priority. Current priorities are as follows, from highest priority to lowest:
- Hard
- - Take
+ - Take (when applicable)
- Auto
- A lock can be initiated manually by clicking the "Lock" link on one of the pages for the ticket (hard lock)
@@ -51,7 +51,7 @@ RT Locking
a) The user is done editing/replying/etc. (for auto locks, if there is no hard lock on the ticket)
b) The user clicks the Unlock link
c) The user logs out
- d) A configurable expiry period has elapsed
+ d) A configurable expiry period has elapsed (if the $LockExpiry config variable has been set to a true value)
- When a user clicks the "Take" link for an RTIR Incident ticket, a Take lock is added. This lock will only be removed
when the Incident is linked to a new or existing Investigation.
@@ -73,10 +73,6 @@ RT Locking
merged-to ticket is locked by a different user, that user will retain the lock. Basically, the merged-to ticket will
retain its lock if it is higher priority than the lock on the ticket being merged from.
-
-
------------
-Optional frills
------------
-
-Lock display portlet for homepage (display all of your locks)
+- When the expiration time has passed, the next time a user looks at the ticket (i.e., RT::Ticket::Locked() is called on it from
+ a Display page or the like, or when the MyLocks portlet is rendered). The entry will not automatically be removed from the database
+ (we'd need to set up a cron job for that), but this shouldn't matter since the lock will be removed when next observed.
diff --git a/t/rt.t b/t/rt.t
index 713baff..50cf5c0 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -28,37 +28,57 @@ $agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link for Ticke
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on Ticket $id");
my $lock = $ticket->Locked();
ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
-sleep 5;
+sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
###Testing that the lock stays###
$agent->follow_link_ok({text => 'History', n => '1'}, "Followed History link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on History page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on History page");
$agent->follow_link_ok({text => 'Basics', n => '1'}, "Followed Basics link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Basics page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Basics page");
$agent->follow_link_ok({text => 'Dates', n => '1'}, "Followed Dates link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Dates page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Dates page");
$agent->follow_link_ok({text => 'People', n => '1'}, "Followed People link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on People page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on People page");
$agent->follow_link_ok({text => 'Links', n => '1'}, "Followed Links link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Links page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Links page");
$agent->follow_link_ok({text => 'Reminders', n => '1'}, "Followed Reminders link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Reminders page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Reminders page");
$agent->follow_link_ok({text => 'Jumbo', n => '1'}, "Followed Jumbo link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Jumbo page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Jumbo page");
$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link for Ticket #$id");
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked on Comment page");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked on Comment page");
$agent->form_number(3);
$agent->click('SubmitTicket');
diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
-$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for}ims, "Ticket #$id still locked after submitting comment");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket locked for \d+ \w+\.\s*</div>}ims, "Ticket #$id still locked after submitting comment");
+$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Followed Unlock link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "Ticket #$id is not locked");
+
+###Testing auto lock###
+
+$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link for Ticket #$id");
+$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Ticket $id is locked");
+# Without this, the lock type doesn't seem to refresh, even on successive calls to Locked()
+$ticket->Load($id);
+$lock = $ticket->Locked();
+ok(($lock->Content->{'Type'} eq 'Auto'), "Lock is an Auto lock");
+diag("Lock is a " . $lock->Content->{'Type'} . " lock.");
+$agent->form_number(3);
+$agent->click('SubmitTicket');
+diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
+$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "Ticket #$id Auto lock is removed");
+
+
+open OF, "> /home/toth/test_html/result_content.html" or die;
+print OF $agent->content;
#removes all user's locks
diff --git a/t/test_suite.pl b/t/test_suite.pl
index 6aa3e99..395d0ba 100644
--- a/t/test_suite.pl
+++ b/t/test_suite.pl
@@ -286,7 +286,7 @@ sub create_ticket {
my $cfs = shift || {};
$agent->get_ok("${RT::WebPath}/Ticket/Create.html?Queue=$queue", "Went to Create page in queue $queue");
- diag("We are at " . $agent->uri);
+
#Enable test scripts to pass in the name of the owner rather than the ID
if ($$fields{Owner} && $$fields{Owner} !~ /^\d+$/)
{
commit 0dcd40b5938557e00791b2f35c92129350e6cced
Author: Turner Hayes <thayes at bestpractical.com>
Date: Fri Aug 17 22:31:42 2007 +0000
* Removed a couple of diagnotic lines I forgot I left in there
diff --git a/t/rt.t b/t/rt.t
index 50cf5c0..1bad2e4 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -77,9 +77,5 @@ diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
$agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked for \d+ \w+\. It is now unlocked\.}ims, "Ticket #$id Auto lock is removed");
-open OF, "> /home/toth/test_html/result_content.html" or die;
-print OF $agent->content;
-
-
#removes all user's locks
$agent->follow_link_ok({text => 'Logout', n => '1'}, "Logging out rtir_test_user");
commit 0d3b633c03e42cd0f34625d9fef2db3a76a23cdf
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Aug 20 18:57:48 2007 +0000
* remove blib and pm_to_blib from repo
* add "1;" to module
diff --git a/blib/arch/.exists b/blib/arch/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/arch/auto/RT/Extension/TicketLocking/.exists b/blib/arch/auto/RT/Extension/TicketLocking/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/bin/.exists b/blib/bin/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/lib/RT/Extension/.exists b/blib/lib/RT/Extension/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/lib/RT/Extension/TicketLocking.pm b/blib/lib/RT/Extension/TicketLocking.pm
deleted file mode 100644
index ac6e147..0000000
--- a/blib/lib/RT/Extension/TicketLocking.pm
+++ /dev/null
@@ -1,175 +0,0 @@
-# BEGIN BPS TAGGED BLOCK {{{
-#
-# COPYRIGHT:
-#
-# This software is Copyright (c) 1996-2007 Best Practical Solutions, LLC
-# <jesse at 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/copyleft/gpl.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::Ticket;
-
-use strict;
-use warnings;
-
-our $VERSION = '0.01';
-
-=head1 NAME
-
-RT::Extension::TicketLocking - Enables users to place advisory locks on tickets
-
-=cut
-
-our @LockTypes = qw(Auto Hard);
-
-sub Locked {
- my $ticket = shift;
- my $lock = $ticket->FirstAttribute('RT_Lock');
- if($lock) {
- my $duration = time() - $lock->Content->{'Timestamp'};
- my $expiry = RT->Config->Get('LockExpiry');
- if($expiry) {
- unless($duration < $expiry) {
- $ticket->DeleteAttribute('RT_Lock');
- undef $lock;
- }
- }
- }
- return $lock;
-}
-
-sub Lock {
- my $ticket = shift;
- my $type = shift || 'Auto';
-
- if ( my $lock = $ticket->Locked() ) {
- return undef if $lock->Content->{'User'} != $ticket->CurrentUser->id;
- my $LockType = $lock->Content->{'Type'};
- my $priority;
- my $LockPriority;
- for(my $i = 0; $i < scalar @LockTypes; $i++) {
- $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
- $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
- }
- return undef if $priority <= $LockPriority;
- }
- $ticket->Unlock($type); #Remove any existing locks (because this one has greater priority)
- my $id = $ticket->id;
- my $username = $ticket->CurrentUser->Name;
- $ticket->SetAttribute(
- Name => 'RT_Lock',
- Description => "$type lock on Ticket $id by user $username",
- Content => {
- User => $ticket->CurrentUser->id,
- Timestamp => time(),
- Type => $type,
- Ticket => $id
- }
- );
-}
-
-
-sub Unlock {
- my $ticket = shift;
- my $type = shift || 'Auto';
-
- my $lock = $ticket->RT::Ticket::Locked();
- return (undef, "This ticket was not locked.") unless $lock;
- return (undef, "You cannot unlock a ticket locked by another user.") unless $lock->Content->{User} == $ticket->CurrentUser->id;
-
- my $LockType = $lock->Content->{'Type'};
- my $priority;
- my $LockPriority;
- for(my $i = 0; $i < scalar @LockTypes; $i++) {
- $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
- $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
- }
- return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
- my $duration = time() - $lock->Content->{'Timestamp'};
- $ticket->DeleteAttribute('RT_Lock');
- return ($duration, "You have unlocked this ticket. It was locked for $duration seconds.");
-}
-
-
-sub BreakLock {
- my $ticket = shift;
- return $ticket->DeleteAttribute('RT_Lock');
-}
-
-
-
-
-
-package RT::User;
-
-sub GetLocks {
- my $self = shift;
-
- my $attribs = RT::Attributes->new($self);
- $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
-
- my $expiry = RT->Config->Get('LockExpiry');
- return $attribs->Named('RT_Lock') unless $expiry;
- my @locks;
-
- foreach my $lock ($attribs->Named('RT_Lock')) {
- my $duration = time() - $lock->Content->{'Timestamp'};
- if($duration < $expiry) {
- push @locks, $lock;
- }
- else {
- $lock->Delete();
- }
- }
- return @locks;
-}
-
-sub RemoveLocks {
- my $self = shift;
-
- my $attribs = RT::Attributes->new($self);
- $attribs->Limit(FIELD => 'Creator', OPERATOR=> '=', VALUE => $self->id(), ENTRYAGGREGATOR => 'AND');
- my @attributes = $attribs->Named('RT_Lock');
- foreach my $lock (@attributes) {
- $lock->Delete();
- }
-}
diff --git a/blib/lib/auto/RT/Extension/TicketLocking/.exists b/blib/lib/auto/RT/Extension/TicketLocking/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/man1/.exists b/blib/man1/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/man3/.exists b/blib/man3/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/blib/man3/RT::Extension::TicketLocking.3pm b/blib/man3/RT::Extension::TicketLocking.3pm
deleted file mode 100644
index 09676c7..0000000
--- a/blib/man3/RT::Extension::TicketLocking.3pm
+++ /dev/null
@@ -1,134 +0,0 @@
-.\" Automatically generated by Pod::Man v1.37, Pod::Parser v1.32
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sh \" Subsection heading
-.br
-.if t .Sp
-.ne 5
-.PP
-\fB\\$1\fR
-.PP
-..
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-'br\}
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.if \nF \{\
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. nr % 0
-. rr F
-.\}
-.\"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.hy 0
-.if n .na
-.\"
-.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2).
-.\" Fear. Run. Save yourself. No user-serviceable parts.
-. \" fudge factors for nroff and troff
-.if n \{\
-. ds #H 0
-. ds #V .8m
-. ds #F .3m
-. ds #[ \f1
-. ds #] \fP
-.\}
-.if t \{\
-. ds #H ((1u-(\\\\n(.fu%2u))*.13m)
-. ds #V .6m
-. ds #F 0
-. ds #[ \&
-. ds #] \&
-.\}
-. \" simple accents for nroff and troff
-.if n \{\
-. ds ' \&
-. ds ` \&
-. ds ^ \&
-. ds , \&
-. ds ~ ~
-. ds /
-.\}
-.if t \{\
-. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u"
-. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u'
-. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u'
-. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u'
-. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u'
-. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u'
-.\}
-. \" troff and (daisy-wheel) nroff accents
-.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V'
-.ds 8 \h'\*(#H'\(*b\h'-\*(#H'
-.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#]
-.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H'
-.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u'
-.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#]
-.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#]
-.ds ae a\h'-(\w'a'u*4/10)'e
-.ds Ae A\h'-(\w'A'u*4/10)'E
-. \" corrections for vroff
-.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u'
-.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u'
-. \" for low resolution devices (crt and lpr)
-.if \n(.H>23 .if \n(.V>19 \
-\{\
-. ds : e
-. ds 8 ss
-. ds o a
-. ds d- d\h'-1'\(ga
-. ds D- D\h'-1'\(hy
-. ds th \o'bp'
-. ds Th \o'LP'
-. ds ae ae
-. ds Ae AE
-.\}
-.rm #[ #] #H #V #F C
-.\" ========================================================================
-.\"
-.IX Title "RT::Extension::TicketLocking 3pm"
-.TH RT::Extension::TicketLocking 3pm "2007-08-17" "perl v5.8.8" "User Contributed Perl Documentation"
-.SH "NAME"
-RT::Extension::TicketLocking \- Enables users to place advisory locks on tickets
diff --git a/blib/script/.exists b/blib/script/.exists
deleted file mode 100644
index e69de29..0000000
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index ac6e147..4788cc0 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -173,3 +173,5 @@ sub RemoveLocks {
$lock->Delete();
}
}
+
+1;
diff --git a/pm_to_blib b/pm_to_blib
deleted file mode 100644
index e69de29..0000000
commit c75d7d11781511b6951717f93e3236a62620e240
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Aug 20 19:11:39 2007 +0000
* rm Makefile from the repo
diff --git a/Makefile b/Makefile
deleted file mode 100644
index a476571..0000000
--- a/Makefile
+++ /dev/null
@@ -1,770 +0,0 @@
-# This Makefile is for the RT::Extension::TicketLocking extension to perl.
-#
-# It was generated automatically by MakeMaker version
-# 6.30_01 (Revision: Revision: 4535 ) from the contents of
-# Makefile.PL. Don't edit this file, edit Makefile.PL instead.
-#
-# ANY CHANGES MADE HERE WILL BE LOST!
-#
-# MakeMaker ARGV: ()
-#
-# MakeMaker Parameters:
-
-# ABSTRACT => q[Enables users to place advisory locks on tickets]
-# AUTHOR => q[Turner Hayes <thayes at bestpractical.com>]
-# DIR => []
-# DISTNAME => q[RT-Extension-TicketLocking]
-# INSTALLSITELIB => q[/opt/rt3/local/lib]
-# NAME => q[RT::Extension::TicketLocking]
-# NO_META => q[1]
-# PL_FILES => { }
-# PREREQ_PM => { Test::More=>q[0] }
-# VERSION => q[0.01]
-# dist => { }
-
-# --- MakeMaker post_initialize section:
-
-
-# --- MakeMaker const_config section:
-
-# These definitions are from config.sh (via /usr/lib/perl/5.8/Config.pm)
-
-# They may have been overridden via Makefile.PL or on the command line
-AR = ar
-CC = cc
-CCCDLFLAGS = -fPIC
-CCDLFLAGS = -Wl,-E
-DLEXT = so
-DLSRC = dl_dlopen.xs
-LD = cc
-LDDLFLAGS = -shared -L/usr/local/lib
-LDFLAGS = -L/usr/local/lib
-LIBC = /lib/libc-2.5.so
-LIB_EXT = .a
-OBJ_EXT = .o
-OSNAME = linux
-OSVERS = 2.6.15.7
-RANLIB = :
-SITELIBEXP = /usr/local/share/perl/5.8.8
-SITEARCHEXP = /usr/local/lib/perl/5.8.8
-SO = so
-EXE_EXT =
-FULL_AR = /usr/bin/ar
-VENDORARCHEXP = /usr/lib/perl5
-VENDORLIBEXP = /usr/share/perl5
-
-
-# --- MakeMaker constants section:
-AR_STATIC_ARGS = cr
-DIRFILESEP = /
-DFSEP = $(DIRFILESEP)
-NAME = RT::Extension::TicketLocking
-NAME_SYM = RT_Extension_TicketLocking
-VERSION = 0.01
-VERSION_MACRO = VERSION
-VERSION_SYM = 0_01
-DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
-XS_VERSION = 0.01
-XS_VERSION_MACRO = XS_VERSION
-XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
-INST_ARCHLIB = blib/arch
-INST_SCRIPT = blib/script
-INST_BIN = blib/bin
-INST_LIB = blib/lib
-INST_MAN1DIR = blib/man1
-INST_MAN3DIR = blib/man3
-MAN1EXT = 1p
-MAN3EXT = 3pm
-INSTALLDIRS = site
-DESTDIR =
-PREFIX = /usr
-PERLPREFIX = $(PREFIX)
-SITEPREFIX = $(PREFIX)/local
-VENDORPREFIX = $(PREFIX)
-INSTALLPRIVLIB = $(PERLPREFIX)/share/perl/5.8
-DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
-INSTALLSITELIB = /opt/rt3/local/lib
-DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
-INSTALLVENDORLIB = $(VENDORPREFIX)/share/perl5
-DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
-INSTALLARCHLIB = $(PERLPREFIX)/lib/perl/5.8
-DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
-INSTALLSITEARCH = /usr/local/lib/perl/5.8.8
-DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
-INSTALLVENDORARCH = $(VENDORPREFIX)/lib/perl5
-DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
-INSTALLBIN = $(PERLPREFIX)/bin
-DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
-INSTALLSITEBIN = $(SITEPREFIX)/bin
-DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
-INSTALLVENDORBIN = $(VENDORPREFIX)/bin
-DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
-INSTALLSCRIPT = $(PERLPREFIX)/bin
-DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
-INSTALLSITESCRIPT = $(SITEPREFIX)/bin
-DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
-INSTALLVENDORSCRIPT = $(VENDORPREFIX)/bin
-DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
-INSTALLMAN1DIR = $(PERLPREFIX)/share/man/man1
-DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
-INSTALLSITEMAN1DIR = $(SITEPREFIX)/man/man1
-DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
-INSTALLVENDORMAN1DIR = $(VENDORPREFIX)/share/man/man1
-DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
-INSTALLMAN3DIR = $(PERLPREFIX)/share/man/man3
-DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
-INSTALLSITEMAN3DIR = $(SITEPREFIX)/man/man3
-DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
-INSTALLVENDORMAN3DIR = $(VENDORPREFIX)/share/man/man3
-DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
-PERL_LIB =
-PERL_ARCHLIB = /usr/lib/perl/5.8
-LIBPERL_A = libperl.a
-FIRST_MAKEFILE = Makefile
-MAKEFILE_OLD = Makefile.old
-MAKE_APERL_FILE = Makefile.aperl
-PERLMAINCC = $(CC)
-PERL_INC = /usr/lib/perl/5.8/CORE
-PERL = /usr/bin/perl "-Iinc"
-FULLPERL = /usr/bin/perl "-Iinc"
-ABSPERL = $(PERL)
-PERLRUN = $(PERL)
-FULLPERLRUN = $(FULLPERL)
-ABSPERLRUN = $(ABSPERL)
-PERLRUNINST = $(PERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
-FULLPERLRUNINST = $(FULLPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
-ABSPERLRUNINST = $(ABSPERLRUN) "-I$(INST_ARCHLIB)" "-Iinc" "-I$(INST_LIB)"
-PERL_CORE = 0
-PERM_RW = 644
-PERM_RWX = 755
-
-MAKEMAKER = /usr/share/perl/5.8/ExtUtils/MakeMaker.pm
-MM_VERSION = 6.30_01
-MM_REVISION = Revision: 4535
-
-# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
-# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
-# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
-# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
-FULLEXT = RT/Extension/TicketLocking
-BASEEXT = TicketLocking
-PARENT_NAME = RT::Extension
-DLBASE = $(BASEEXT)
-VERSION_FROM =
-OBJECT =
-LDFROM = $(OBJECT)
-LINKTYPE = dynamic
-BOOTDEP =
-
-# Handy lists of source code files:
-XS_FILES =
-C_FILES =
-O_FILES =
-H_FILES =
-MAN1PODS =
-MAN3PODS = lib/RT/Extension/TicketLocking.pm
-
-# Where is the Config information that we are using/depend on
-CONFIGDEP = $(PERL_ARCHLIB)$(DFSEP)Config.pm $(PERL_INC)$(DFSEP)config.h
-
-# Where to build things
-INST_LIBDIR = $(INST_LIB)/RT/Extension
-INST_ARCHLIBDIR = $(INST_ARCHLIB)/RT/Extension
-
-INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
-INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
-
-INST_STATIC =
-INST_DYNAMIC =
-INST_BOOT =
-
-# Extra linker info
-EXPORT_LIST =
-PERL_ARCHIVE =
-PERL_ARCHIVE_AFTER =
-
-
-TO_INST_PM = lib/RT/Extension/TicketLocking.pm
-
-PM_TO_BLIB = lib/RT/Extension/TicketLocking.pm \
- blib/lib/RT/Extension/TicketLocking.pm
-
-
-# --- MakeMaker platform_constants section:
-MM_Unix_VERSION = 1.50_01
-PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
-
-
-# --- MakeMaker tool_autosplit section:
-# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
-AUTOSPLITFILE = $(ABSPERLRUN) -e 'use AutoSplit; autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1)'
-
-
-
-# --- MakeMaker tool_xsubpp section:
-
-
-# --- MakeMaker tools_other section:
-SHELL = /bin/sh
-CHMOD = chmod
-CP = cp
-MV = mv
-NOOP = $(SHELL) -c true
-NOECHO = @
-RM_F = rm -f
-RM_RF = rm -rf
-TEST_F = test -f
-TOUCH = touch
-UMASK_NULL = umask 0
-DEV_NULL = > /dev/null 2>&1
-MKPATH = $(ABSPERLRUN) "-MExtUtils::Command" -e mkpath
-EQUALIZE_TIMESTAMP = $(ABSPERLRUN) "-MExtUtils::Command" -e eqtime
-ECHO = echo
-ECHO_N = echo -n
-UNINST = 0
-VERBINST = 0
-MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install({@ARGV}, '\''$(VERBINST)'\'', 0, '\''$(UNINST)'\'');'
-DOC_INSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e perllocal_install
-UNINSTALL = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e uninstall
-WARN_IF_OLD_PACKLIST = $(ABSPERLRUN) "-MExtUtils::Command::MM" -e warn_if_old_packlist
-MACROSTART =
-MACROEND =
-USEMAKEFILE = -f
-FIXIN = $(PERLRUN) "-MExtUtils::MY" -e "MY->fixin(shift)"
-
-
-# --- MakeMaker makemakerdflt section:
-makemakerdflt: all
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dist section:
-TAR = tar
-TARFLAGS = cvf
-ZIP = zip
-ZIPFLAGS = -r
-COMPRESS = gzip --best
-SUFFIX = .gz
-SHAR = shar
-PREOP = $(NOECHO) $(NOOP)
-POSTOP = $(NOECHO) $(NOOP)
-TO_UNIX = $(NOECHO) $(NOOP)
-CI = ci -u
-RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
-DIST_CP = best
-DIST_DEFAULT = tardist
-DISTNAME = RT-Extension-TicketLocking
-DISTVNAME = RT-Extension-TicketLocking-0.01
-
-
-# --- MakeMaker macro section:
-
-
-# --- MakeMaker depend section:
-
-
-# --- MakeMaker cflags section:
-
-
-# --- MakeMaker const_loadlibs section:
-
-
-# --- MakeMaker const_cccmd section:
-
-
-# --- MakeMaker post_constants section:
-
-
-# --- MakeMaker pasthru section:
-
-PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
- LINKTYPE="$(LINKTYPE)"\
- PREFIX="$(PREFIX)"
-
-
-# --- MakeMaker special_targets section:
-.SUFFIXES : .xs .c .C .cpp .i .s .cxx .cc $(OBJ_EXT)
-
-.PHONY: all config static dynamic test linkext manifest blibdirs clean realclean disttest distdir
-
-
-
-# --- MakeMaker c_o section:
-
-
-# --- MakeMaker xs_c section:
-
-
-# --- MakeMaker xs_o section:
-
-
-# --- MakeMaker top_targets section:
-all :: pure_all manifypods
- $(NOECHO) $(NOOP)
-
-
-pure_all :: config pm_to_blib subdirs linkext
- $(NOECHO) $(NOOP)
-
-subdirs :: $(MYEXTLIB)
- $(NOECHO) $(NOOP)
-
-config :: $(FIRST_MAKEFILE) blibdirs
- $(NOECHO) $(NOOP)
-
-help :
- perldoc ExtUtils::MakeMaker
-
-
-# --- MakeMaker blibdirs section:
-blibdirs : $(INST_LIBDIR)$(DFSEP).exists $(INST_ARCHLIB)$(DFSEP).exists $(INST_AUTODIR)$(DFSEP).exists $(INST_ARCHAUTODIR)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists $(INST_SCRIPT)$(DFSEP).exists $(INST_MAN1DIR)$(DFSEP).exists $(INST_MAN3DIR)$(DFSEP).exists
- $(NOECHO) $(NOOP)
-
-# Backwards compat with 6.18 through 6.25
-blibdirs.ts : blibdirs
- $(NOECHO) $(NOOP)
-
-$(INST_LIBDIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_LIBDIR)
- $(NOECHO) $(CHMOD) 755 $(INST_LIBDIR)
- $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
-
-$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
- $(NOECHO) $(CHMOD) 755 $(INST_ARCHLIB)
- $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
-
-$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_AUTODIR)
- $(NOECHO) $(CHMOD) 755 $(INST_AUTODIR)
- $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
-
-$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
- $(NOECHO) $(CHMOD) 755 $(INST_ARCHAUTODIR)
- $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
-
-$(INST_BIN)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_BIN)
- $(NOECHO) $(CHMOD) 755 $(INST_BIN)
- $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
-
-$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_SCRIPT)
- $(NOECHO) $(CHMOD) 755 $(INST_SCRIPT)
- $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
-
-$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
- $(NOECHO) $(CHMOD) 755 $(INST_MAN1DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
-
-$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
- $(NOECHO) $(CHMOD) 755 $(INST_MAN3DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
-
-
-
-# --- MakeMaker linkext section:
-
-linkext :: $(LINKTYPE)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dlsyms section:
-
-
-# --- MakeMaker dynamic section:
-
-dynamic :: $(FIRST_MAKEFILE) $(INST_DYNAMIC) $(INST_BOOT)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dynamic_bs section:
-
-BOOTSTRAP =
-
-
-# --- MakeMaker dynamic_lib section:
-
-
-# --- MakeMaker static section:
-
-## $(INST_PM) has been moved to the all: target.
-## It remains here for awhile to allow for old usage: "make static"
-static :: $(FIRST_MAKEFILE) $(INST_STATIC)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker static_lib section:
-
-
-# --- MakeMaker manifypods section:
-
-POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
-POD2MAN = $(POD2MAN_EXE)
-
-
-manifypods : pure_all \
- lib/RT/Extension/TicketLocking.pm \
- lib/RT/Extension/TicketLocking.pm
- $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) \
- lib/RT/Extension/TicketLocking.pm $(INST_MAN3DIR)/RT::Extension::TicketLocking.$(MAN3EXT)
-
-
-
-
-# --- MakeMaker processPL section:
-
-
-# --- MakeMaker installbin section:
-
-
-# --- MakeMaker subdirs section:
-
-# none
-
-# --- MakeMaker clean_subdirs section:
-clean_subdirs :
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker clean section:
-
-# Delete temporary files but do not touch installed files. We don't delete
-# the Makefile here so a later make realclean still has a makefile to use.
-
-clean :: clean_subdirs
- - $(RM_F) \
- *$(LIB_EXT) core \
- core.[0-9] $(INST_ARCHAUTODIR)/extralibs.all \
- core.[0-9][0-9] $(BASEEXT).bso \
- pm_to_blib.ts core.[0-9][0-9][0-9][0-9] \
- $(BASEEXT).x $(BOOTSTRAP) \
- perl$(EXE_EXT) tmon.out \
- *$(OBJ_EXT) pm_to_blib \
- $(INST_ARCHAUTODIR)/extralibs.ld blibdirs.ts \
- core.[0-9][0-9][0-9][0-9][0-9] *perl.core \
- core.*perl.*.? $(MAKE_APERL_FILE) \
- perl $(BASEEXT).def \
- core.[0-9][0-9][0-9] mon.out \
- lib$(BASEEXT).def perlmain.c \
- perl.exe so_locations \
- $(BASEEXT).exp
- - $(RM_RF) \
- blib
- - $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD) $(DEV_NULL)
-
-
-# --- MakeMaker realclean_subdirs section:
-realclean_subdirs :
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker realclean section:
-# Delete temporary files (via clean) and also delete dist files
-realclean purge :: clean realclean_subdirs
- - $(RM_F) \
- $(MAKEFILE_OLD) $(FIRST_MAKEFILE)
- - $(RM_RF) \
- $(DISTVNAME)
-
-
-# --- MakeMaker metafile section:
-metafile:
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker signature section:
-signature :
- cpansign -s
-
-
-# --- MakeMaker dist_basics section:
-distclean :: realclean distcheck
- $(NOECHO) $(NOOP)
-
-distcheck :
- $(PERLRUN) "-MExtUtils::Manifest=fullcheck" -e fullcheck
-
-skipcheck :
- $(PERLRUN) "-MExtUtils::Manifest=skipcheck" -e skipcheck
-
-manifest :
- $(PERLRUN) "-MExtUtils::Manifest=mkmanifest" -e mkmanifest
-
-veryclean : realclean
- $(RM_F) *~ *.orig */*~ */*.orig
-
-
-
-# --- MakeMaker dist_core section:
-
-dist : $(DIST_DEFAULT) $(FIRST_MAKEFILE)
- $(NOECHO) $(ABSPERLRUN) -l -e 'print '\''Warning: Makefile possibly out of date with $(VERSION_FROM)'\''' \
- -e ' if -e '\''$(VERSION_FROM)'\'' and -M '\''$(VERSION_FROM)'\'' < -M '\''$(FIRST_MAKEFILE)'\'';'
-
-tardist : $(DISTVNAME).tar$(SUFFIX)
- $(NOECHO) $(NOOP)
-
-uutardist : $(DISTVNAME).tar$(SUFFIX)
- uuencode $(DISTVNAME).tar$(SUFFIX) $(DISTVNAME).tar$(SUFFIX) > $(DISTVNAME).tar$(SUFFIX)_uu
-
-$(DISTVNAME).tar$(SUFFIX) : distdir
- $(PREOP)
- $(TO_UNIX)
- $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(COMPRESS) $(DISTVNAME).tar
- $(POSTOP)
-
-zipdist : $(DISTVNAME).zip
- $(NOECHO) $(NOOP)
-
-$(DISTVNAME).zip : distdir
- $(PREOP)
- $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(POSTOP)
-
-shdist : distdir
- $(PREOP)
- $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
- $(RM_RF) $(DISTVNAME)
- $(POSTOP)
-
-
-# --- MakeMaker distdir section:
-create_distdir :
- $(RM_RF) $(DISTVNAME)
- $(PERLRUN) "-MExtUtils::Manifest=manicopy,maniread" \
- -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
-
-distdir : create_distdir
- $(NOECHO) $(NOOP)
-
-
-
-# --- MakeMaker dist_test section:
-disttest : distdir
- cd $(DISTVNAME) && $(ABSPERLRUN) Makefile.PL
- cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
- cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
-
-
-
-# --- MakeMaker dist_ci section:
-
-ci :
- $(PERLRUN) "-MExtUtils::Manifest=maniread" \
- -e "@all = keys %{ maniread() };" \
- -e "print(qq{Executing $(CI) @all\n}); system(qq{$(CI) @all});" \
- -e "print(qq{Executing $(RCS_LABEL) ...\n}); system(qq{$(RCS_LABEL) @all});"
-
-
-# --- MakeMaker distmeta section:
-distmeta : create_distdir metafile
- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{META.yml} => q{Module meta-data (added by MakeMaker)}}) } ' \
- -e ' or print "Could not add META.yml to MANIFEST: $${'\''@'\''}\n"'
-
-
-
-# --- MakeMaker distsignature section:
-distsignature : create_distdir
- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'eval { maniadd({q{SIGNATURE} => q{Public-key signature (added by MakeMaker)}}) } ' \
- -e ' or print "Could not add SIGNATURE to MANIFEST: $${'\''@'\''}\n"'
- $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
- cd $(DISTVNAME) && cpansign -s
-
-
-
-# --- MakeMaker install section:
-
-install :: all pure_install doc_install
- $(NOECHO) $(NOOP)
-
-install_perl :: all pure_perl_install doc_perl_install
- $(NOECHO) $(NOOP)
-
-install_site :: all pure_site_install doc_site_install
- $(NOECHO) $(NOOP)
-
-install_vendor :: all pure_vendor_install doc_vendor_install
- $(NOECHO) $(NOOP)
-
-pure_install :: pure_$(INSTALLDIRS)_install
- $(NOECHO) $(NOOP)
-
-doc_install :: doc_$(INSTALLDIRS)_install
- $(NOECHO) $(NOOP)
-
-pure__install : pure_site_install
- $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
-
-doc__install : doc_site_install
- $(NOECHO) $(ECHO) INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
-
-pure_perl_install ::
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- $(INST_LIB) $(DESTINSTALLPRIVLIB) \
- $(INST_ARCHLIB) $(DESTINSTALLARCHLIB) \
- $(INST_BIN) $(DESTINSTALLBIN) \
- $(INST_SCRIPT) $(DESTINSTALLSCRIPT) \
- $(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) \
- $(INST_MAN3DIR) $(DESTINSTALLMAN3DIR)
- $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
- $(SITEARCHEXP)/auto/$(FULLEXT)
-
-
-pure_site_install ::
- $(NOECHO) umask 02; $(MOD_INSTALL) \
- read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
- write $(DESTINSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
- $(INST_LIB) $(DESTINSTALLSITELIB) \
- $(INST_ARCHLIB) $(DESTINSTALLSITEARCH) \
- $(INST_BIN) $(DESTINSTALLSITEBIN) \
- $(INST_SCRIPT) $(DESTINSTALLSITESCRIPT) \
- $(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) \
- $(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR)
- $(NOECHO) $(WARN_IF_OLD_PACKLIST) \
- $(PERL_ARCHLIB)/auto/$(FULLEXT)
-
-pure_vendor_install ::
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- $(INST_LIB) $(DESTINSTALLVENDORLIB) \
- $(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) \
- $(INST_BIN) $(DESTINSTALLVENDORBIN) \
- $(INST_SCRIPT) $(DESTINSTALLVENDORSCRIPT) \
- $(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) \
- $(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR)
-
-doc_perl_install ::
-
-doc_site_install ::
- $(NOECHO) $(ECHO) Appending installation info to $(DESTINSTALLSITEARCH)/perllocal.pod
- -$(NOECHO) umask 02; $(MKPATH) $(DESTINSTALLSITEARCH)
- -$(NOECHO) umask 02; $(DOC_INSTALL) \
- "Module" "$(NAME)" \
- "installed into" "$(INSTALLSITELIB)" \
- LINKTYPE "$(LINKTYPE)" \
- VERSION "$(VERSION)" \
- EXE_FILES "$(EXE_FILES)" \
- >> $(DESTINSTALLSITEARCH)/perllocal.pod
-
-doc_vendor_install ::
-
-
-uninstall :: uninstall_from_$(INSTALLDIRS)dirs
- $(NOECHO) $(NOOP)
-
-uninstall_from_perldirs ::
-
-uninstall_from_sitedirs ::
- $(NOECHO) $(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
-
-uninstall_from_vendordirs ::
-
-
-
-# --- MakeMaker force section:
-# Phony target to force checking subdirectories.
-FORCE:
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker perldepend section:
-
-
-# --- MakeMaker makefile section:
-# We take a very conservative approach here, but it's worth it.
-# We move Makefile to Makefile.old here to avoid gnu make looping.
-$(FIRST_MAKEFILE) : Makefile.PL $(CONFIGDEP)
- $(NOECHO) $(ECHO) "Makefile out-of-date with respect to $?"
- $(NOECHO) $(ECHO) "Cleaning current config before rebuilding Makefile..."
- -$(NOECHO) $(RM_F) $(MAKEFILE_OLD)
- -$(NOECHO) $(MV) $(FIRST_MAKEFILE) $(MAKEFILE_OLD)
- - $(MAKE) $(USEMAKEFILE) $(MAKEFILE_OLD) clean $(DEV_NULL)
- $(PERLRUN) Makefile.PL
- $(NOECHO) $(ECHO) "==> Your Makefile has been rebuilt. <=="
- $(NOECHO) $(ECHO) "==> Please rerun the $(MAKE) command. <=="
- false
-
-
-
-# --- MakeMaker staticmake section:
-
-# --- MakeMaker makeaperl section ---
-MAP_TARGET = perl
-FULLPERL = /usr/bin/perl
-
-$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
- $(MAKE) $(USEMAKEFILE) $(MAKE_APERL_FILE) $@
-
-$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE) pm_to_blib
- $(NOECHO) $(ECHO) Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
- $(NOECHO) $(PERLRUNINST) \
- Makefile.PL DIR= \
- MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
- MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
-
-
-# --- MakeMaker test section:
-
-TEST_VERBOSE=0
-TEST_TYPE=test_$(LINKTYPE)
-TEST_FILE = test.pl
-TEST_FILES =
-TESTDB_SW = -d
-
-testdb :: testdb_$(LINKTYPE)
-
-test :: $(TEST_TYPE)
- $(NOECHO) $(ECHO) 'No tests defined for $(NAME) extension.'
-
-test_dynamic :: pure_all
-
-testdb_dynamic :: pure_all
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-Iinc" "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-test_ : test_dynamic
-
-test_static :: test_dynamic
-testdb_static :: testdb_dynamic
-
-
-# --- MakeMaker ppd section:
-# Creates a PPD (Perl Package Description) for a binary distribution.
-ppd:
- $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="0,01,0,0">' > $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <TITLE>$(DISTNAME)</TITLE>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ABSTRACT>Enables users to place advisory locks on tickets</ABSTRACT>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <AUTHOR>Turner Hayes <thayes at bestpractical.com></AUTHOR>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <DEPENDENCY NAME="Test-More" VERSION="0,0,0,0" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <OS NAME="$(OSNAME)" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="i486-linux-gnu-thread-multi" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <CODEBASE HREF="" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' </IMPLEMENTATION>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) '</SOFTPKG>' >> $(DISTNAME).ppd
-
-
-# --- MakeMaker pm_to_blib section:
-
-pm_to_blib : $(TO_INST_PM)
- $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', '\''$(PM_FILTER)'\'')' \
- lib/RT/Extension/TicketLocking.pm blib/lib/RT/Extension/TicketLocking.pm
- $(NOECHO) $(TOUCH) pm_to_blib
-
-
-# --- MakeMaker selfdocument section:
-
-
-# --- MakeMaker postamble section:
-
-
-# End.
-# Postamble by Module::Install 0.67
-install ::
- $(NOECHO) $(PERL) -MExtUtils::Install -e "install({q(html), q(/opt/rt3/share/html)})"
-
commit 7e82cd276217026343259ce67565cecce82bc87d
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Aug 20 19:37:49 2007 +0000
* update MANIFEST
diff --git a/MANIFEST b/MANIFEST
index eec9aea..43be0e1 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,7 +1,51 @@
+docs/locking
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/TicketTakeOrSteal
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Elements/QueueTabs/Default
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/LinkToIncident.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Split.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Merge.html/MergeTicketSelected
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Split.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/Initial
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Forward.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/History.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Modify.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyAll.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyDates.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyLinks.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/ModifyPeople.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Reminders.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeActionList
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
+html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/Initial
html/Elements/MyLocks
html/Elements/ShowLock
-html/Callbacks/Locking/Ticket/Display.html/ProcessLockArgument
-html/Callbacks/Locking/Ticket/Display.html/ShowLock
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
@@ -13,5 +57,8 @@ inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Extension/TicketLocking.pm
Makefile.PL
-MANIFEST
+MANIFEST This list of files
README
+t/rt.t
+t/rtir.t
+t/test_suite.pl
commit 5f705cf4ce7190be9a585da668e08eb57f40104f
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Aug 20 19:38:15 2007 +0000
* add TODO
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..055e18f
--- /dev/null
+++ b/TODO
@@ -0,0 +1,11 @@
+* PODify docs/locking
+** move docs into .pm
+** split implementation details from user level docs
+** add description of portlet 'Element/MyLocks',
+ how to add to home page, how to setup config...
+
+* add check for RT version to Makefile.PL
+
+* use M::I::Substitute, in tests we need correct lib paths
+
+
commit 4ed20ab0c0309c3e15a7cc2fb7c5e6b336b460dc
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Aug 20 23:54:24 2007 +0000
* let's add a callback to autohandler, we shouldn't force pure users
to put cryptic perl code into the config to load the extension.
diff --git a/html/Callbacks/RT-Extension-TicketLocking/autohandler/Default b/html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
new file mode 100644
index 0000000..c0f40fe
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
@@ -0,0 +1,7 @@
+<%INIT>
+local $@;
+eval { require RT::Extension::TicketLocking };
+$RT::Logger->error( $@ ) if $@;
+
+return;
+</%INIT>
commit 998e17d7f5231e7b3df715004708eeb50e4754ee
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Aug 21 00:01:54 2007 +0000
* we shouln't be lazy on typing or later we'll be forced to type more
by angry users suffering from bugs, so stop parsing texts and use API.
diff --git a/t/test_suite.pl b/t/test_suite.pl
index 395d0ba..df4e6c4 100644
--- a/t/test_suite.pl
+++ b/t/test_suite.pl
@@ -288,11 +288,12 @@ sub create_ticket {
$agent->get_ok("${RT::WebPath}/Ticket/Create.html?Queue=$queue", "Went to Create page in queue $queue");
#Enable test scripts to pass in the name of the owner rather than the ID
- if ($$fields{Owner} && $$fields{Owner} !~ /^\d+$/)
- {
- if($agent->content =~ qr{<option.+?value="(\d+)"\s*>$$fields{Owner}</option>}ims) {
- $$fields{Owner} = $1;
- }
+ if ( $fields->{'Owner'} && $fields->{'Owner'} !~ /^\d+$/ ) {
+ my $u = RT::User->new( $RT::SystemUser );
+ $u->Load( $fields->{'Owner'} );
+ die "Couldn't load user '". $fields->{'Owner'} ."'"
+ unless $u->id;
+ $fields->{'Owner'} = $u->id;
}
$agent->form_number(3);
commit dbbc5facb1e392ff7d5ad673ac5c3ac3d15a49cf
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Aug 21 00:04:48 2007 +0000
* let's make test_suite.pl file a little bit independant
from presense of rtir
diff --git a/t/test_suite.pl b/t/test_suite.pl
index df4e6c4..17a0cca 100644
--- a/t/test_suite.pl
+++ b/t/test_suite.pl
@@ -26,8 +26,9 @@ use RT::Test::Web;
sub default_agent {
my $agent = new RT::Test::Web;
$agent->cookie_jar( HTTP::Cookies->new );
+ my $u = rtir_user();
$agent->login($RTIR_TEST_USER, $RTIR_TEST_PASS);
- go_home($agent);
+ $agent->get_ok("/index.html", "loaded home page");
return $agent;
}
@@ -40,17 +41,11 @@ sub set_custom_field {
return 1;
}
-sub go_home {
- my $agent = shift;
- my $weburl = RT->Config->Get('WebURL');
- $agent->get_ok("$weburl/RTIR/index.html", "Loaded home page");
-}
-
sub display_ticket {
my $agent = shift;
my $id = shift;
- $agent->get_ok(RT->Config->Get('WebURL') . "/RTIR/Display.html?id=$id", "Loaded Display page for Ticket #$id");
+ $agent->get_ok("/RTIR/Display.html?id=$id", "Loaded Display page for Ticket #$id");
}
sub ticket_state_is {
@@ -112,7 +107,7 @@ sub goto_create_rtir_ticket {
'Incidents' => 'Incident'
);
- go_home($agent);
+ $agent->get_ok("/RTIR/index.html", "loaded home page");
$agent->follow_link_ok({text => $queue, n => "1"}, "Followed '$queue' link");
$agent->follow_link_ok({text => "New ". $type{ $queue }, n => "1"}, "Followed 'New $type{$queue}' link");
@@ -180,7 +175,10 @@ sub get_ticket_id {
$id = $1;
}
elsif ($content =~ /.*No permission to view newly created ticket #(\d+).*/g) {
- diag("\nNo permissions to view the ticket.\n") if($ENV{'TEST_VERBOSE'});
+ diag "No permissions to view the ticket" if $ENV{'TEST_VERBOSE'};
+ }
+ else {
+ diag "Couldn't find ticket id in:\n$content" if $ENV{'TEST_VERBOSE'};
}
return $id;
}
@@ -235,7 +233,8 @@ sub create_incident_and_investigation {
my $cfs = shift || {};
my $ir_id = shift;
- $ir_id ? display_ticket($agent, $ir_id) : go_home($agent);
+ $ir_id ? display_ticket($agent, $ir_id)
+ : $agent->get_ok("/index.html", "loaded home page");
if($ir_id) {
# Select the "New" link from the Display page
@@ -279,13 +278,20 @@ sub create_incident_and_investigation {
sub create_ticket {
my $agent = shift;
my $queue = shift || 'General';
-
- return create_rtir_ticket($agent, $queue, @_) if $queue eq 'Incidents' || $queue eq 'Blocks' || $queue eq 'Investigations' || $queue eq 'Incident Reports';
+
+ return create_rtir_ticket($agent, $queue, @_)
+ if $queue eq 'Incidents'
+ || $queue eq 'Blocks'
+ || $queue eq 'Investigations'
+ || $queue eq 'Incident Reports';
my $fields = shift || {};
my $cfs = shift || {};
-
- $agent->get_ok("${RT::WebPath}/Ticket/Create.html?Queue=$queue", "Went to Create page in queue $queue");
+
+ $agent->get_ok(
+ "/Ticket/Create.html?Queue=$queue",
+ "Went to Create page in queue $queue",
+ );
#Enable test scripts to pass in the name of the owner rather than the ID
if ( $fields->{'Owner'} && $fields->{'Owner'} !~ /^\d+$/ ) {
@@ -297,7 +303,6 @@ sub create_ticket {
}
$agent->form_number(3);
- $fields->{'Requestors'} ||= $RTIR_TEST_USER if $queue eq 'Investigations';
while (my ($f, $v) = each %$fields) {
$agent->field($f, $v);
}
commit 7caf4f78120553452eae4342d7e237532db04e6c
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Aug 21 00:08:43 2007 +0000
* user need rights to work with RT
diff --git a/t/rt.t b/t/rt.t
index 1bad2e4..f766e29 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -2,27 +2,38 @@
use strict;
use warnings;
-
-
-use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
-
use Test::More qw/no_plan/;
use HTTP::Cookies;
require "t/test_suite.pl";
+my $queue = RT::Test->load_or_create_queue( Name => 'General' );
+ok $queue && $queue->id, 'loaded or created the queue';
+
+my $test_user = rtir_user();
+ok $test_user && $test_user->id, 'loaded or created user';
+
+RT::Test->set_rights(
+ Principal => $test_user,
+ Right => [qw(SeeQueue CreateTicket OwnTicket ShowTicket )],
+);
+
+use_ok('RT::Extension::TicketLocking');
+
my $agent = default_agent();
my $root = new RT::Test::Web;
$root->cookie_jar( HTTP::Cookies->new );
-$root->login('root', 'password');
+ok $root->login('root', 'password'), 'logged in';
my $SUBJECT = "foo " . rand;
my $id = create_ticket($agent, 'General', {Subject => $SUBJECT});
+ok $id, 'created a ticket';
my $ticket = RT::Ticket->new(RT::SystemUser());
$ticket->Load($id);
+ok $ticket->id, 'loaded ticket';
$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link for Ticket #$id");
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on Ticket $id");
commit 0384a4dde96abed306a4596bc58fb1dab6bb3633
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Aug 21 00:18:39 2007 +0000
* tests should run to the end even if they fail
diff --git a/t/rt.t b/t/rt.t
index f766e29..b19ca7a 100644
--- a/t/rt.t
+++ b/t/rt.t
@@ -16,7 +16,7 @@ ok $test_user && $test_user->id, 'loaded or created user';
RT::Test->set_rights(
Principal => $test_user,
- Right => [qw(SeeQueue CreateTicket OwnTicket ShowTicket )],
+ Right => [qw(SeeQueue CreateTicket OwnTicket ShowTicket ModifyTicket)],
);
use_ok('RT::Extension::TicketLocking');
@@ -38,7 +38,7 @@ ok $ticket->id, 'loaded ticket';
$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed Lock link for Ticket #$id");
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Added a hard lock on Ticket $id");
my $lock = $ticket->Locked();
-ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
+ok( $lock && $lock->Content->{'Type'} eq 'Hard', "Lock is a Hard lock");
sleep 5; #Otherwise, we run the risk of getting "You have locked this ticket" (see /Elements/ShowLock)
###Testing that the lock stays###
@@ -78,10 +78,12 @@ $agent->content_like(qr{<div class="locked-by-you">\s*You had this ticket locked
$agent->follow_link_ok({text => 'Comment', n => '1'}, "Followed Comment link for Ticket #$id");
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Ticket $id is locked");
# Without this, the lock type doesn't seem to refresh, even on successive calls to Locked()
-$ticket->Load($id);
-$lock = $ticket->Locked();
-ok(($lock->Content->{'Type'} eq 'Auto'), "Lock is an Auto lock");
-diag("Lock is a " . $lock->Content->{'Type'} . " lock.");
+{
+ my $ticket = RT::Ticket->new(RT::SystemUser());
+ $ticket->Load($id);
+ my $lock = $ticket->Locked();
+ ok( $lock && $lock->Content->{'Type'} eq 'Auto', "Lock is an Auto lock");
+}
$agent->form_number(3);
$agent->click('SubmitTicket');
diag("Submitted Comment form") if $ENV{'TEST_VERBOSE'};
commit 0d111a4347415ffc14fa8b3a7db3c0eb3158bb03
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Aug 23 18:41:11 2007 +0000
* ARGSref -> ARGSRef
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
index b62b886..dc8b29e 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
@@ -1,12 +1,12 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
if($Ticket) {
my ($d) = $Ticket->Unlock();
- $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
- $$ARGSref{'Id'} = $Ticket->id;
+ $$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
+ $$ARGSRef{'Id'} = $Ticket->id;
}
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
index ce79833..3a35fec 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/ProcessArguments
@@ -1,11 +1,11 @@
<%ARGS>
$Ticket
$Actions => undef
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
-my $Lock = $$ARGSref{'Lock'};
+my $Lock = $$ARGSRef{'Lock'};
return unless $Lock;
if ($Lock eq 'add') {
if ($Ticket->Lock('Hard')) {
@@ -19,7 +19,7 @@ if ( $Lock eq 'remove' ) {
my ($elapsed, $msg) = $Ticket->Unlock('Hard');
push @$Actions, loc($msg);
#print "Elapsed: $elapsed";
- $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ $$ARGSRef{'Duration'} = $elapsed if $elapsed;
return;
}
if ($Lock eq 'break') {
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
index 0c821cd..f2fe01c 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Edit.html/BeforeDisplay
@@ -1,9 +1,9 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
my ($d) = $Ticket->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
index f337902..23d9beb 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/BeforeDisplay
@@ -1,12 +1,12 @@
<%ARGS>
$Child
-$ARGSref
+$ARGSRef
</%ARGS>
<%INIT>
return unless $Child;
-$$ARGSref{'Id'} = $Child->id;
+$$ARGSRef{'Id'} = $Child->id;
my ($d) = $Child->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
index d7bd7ae..714ba58 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Create.html/ProcessArguments
@@ -1,24 +1,24 @@
<%ARGS>
$Ticket => undef
$Child => undef
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
#Split form has been submitted
-if($Ticket && ($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'})) {
- $$ARGSref{'Id'} = $$ARGSref{'Ticket'};
+if($Ticket && ($$ARGSRef{'CreateIncident'} || $$ARGSRef{'CreateWithInvestigation'})) {
+ $$ARGSRef{'Id'} = $$ARGSRef{'Ticket'};
my ($d) = $Ticket->Unlock();
- $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+ $$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
return;
}
if($Child) {
# We don't want to bother even trying to lock if the form has been submitted
# (it will have been locked upon first rendering of the creation page)
- unless($$ARGSref{'CreateIncident'} || $$ARGSref{'CreateWithInvestigation'}) {
+ unless($$ARGSRef{'CreateIncident'} || $$ARGSRef{'CreateWithInvestigation'}) {
$Child->Lock();
}
- $$ARGSref{'Id'} = $$ARGSref{'Child'};
+ $$ARGSRef{'Id'} = $$ARGSRef{'Child'};
}
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
index cc70b7a..6b20b91 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ProcessArguments
@@ -1,11 +1,11 @@
<%ARGS>
$Ticket
$Actions => undef
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
-my $Lock = $$ARGSref{'Lock'};
+my $Lock = $$ARGSRef{'Lock'};
return unless $Lock;
if ($Lock eq 'add') {
if ($Ticket->Lock('Hard')) {
@@ -18,7 +18,7 @@ if ($Lock eq 'add') {
if ( $Lock eq 'remove' ) {
my ($elapsed, $msg) = $Ticket->Unlock('Hard');
push @$Actions, loc($msg);
- $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ $$ARGSRef{'Duration'} = $elapsed if $elapsed;
return;
}
if ($Lock eq 'break') {
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
index f0cdbaf..354ed9d 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Display.html/ThisLinkedToIR
@@ -1,10 +1,10 @@
<%ARGS>
$Child
-$ARGSref
+$ARGSRef
</%ARGS>
<%INIT>
my ($d) = $Child->Unlock('Take');
-$$ARGSref{'Id'} = $Child->id;
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Id'} = $Child->id;
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
index 0c821cd..f2fe01c 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Edit.html/BeforeDisplay
@@ -1,9 +1,9 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
my ($d) = $Ticket->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
index 0c821cd..f2fe01c 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
@@ -1,9 +1,9 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
my ($d) = $Ticket->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
index 0c821cd..f2fe01c 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Update.html/BeforeDisplay
@@ -1,9 +1,9 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
my ($d) = $Ticket->Unlock();
-$$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
</%INIT>
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
index cc70b7a..6b20b91 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/ProcessArguments
@@ -1,11 +1,11 @@
<%ARGS>
$Ticket
$Actions => undef
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
-my $Lock = $$ARGSref{'Lock'};
+my $Lock = $$ARGSRef{'Lock'};
return unless $Lock;
if ($Lock eq 'add') {
if ($Ticket->Lock('Hard')) {
@@ -18,7 +18,7 @@ if ($Lock eq 'add') {
if ( $Lock eq 'remove' ) {
my ($elapsed, $msg) = $Ticket->Unlock('Hard');
push @$Actions, loc($msg);
- $$ARGSref{'Duration'} = $elapsed if $elapsed;
+ $$ARGSRef{'Duration'} = $elapsed if $elapsed;
return;
}
if ($Lock eq 'break') {
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
index 29e3b51..0f1d81f 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
@@ -1,11 +1,11 @@
<%ARGS>
$Ticket
-$ARGSref => undef
+$ARGSRef => undef
</%ARGS>
<%INIT>
if($Ticket) {
my ($d) = $Ticket->Unlock();
- $$ARGSref{'Duration'} = $d unless $$ARGSref{'Duration'};
+ $$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
}
</%INIT>
commit 5f907d460594658b8947614c74023d8f97b9085f
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Aug 23 21:25:21 2007 +0000
* add a test file to check that all callbacks we have are in RT
diff --git a/t/callbacks.t b/t/callbacks.t
new file mode 100644
index 0000000..84b60dc
--- /dev/null
+++ b/t/callbacks.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw/no_plan/;
+
+require "t/test_suite.pl";
+
+my $ok = 1;
+
+use File::Find;
+find( {
+ no_chdir => 1,
+ wanted => sub {
+ return if /(?:\.(?:jpe?g|png|gif|rej)|\~)$/i;
+ if ( m{/\.svn$} ) {
+ $File::Find::prune = 1;
+ return;
+ }
+ return unless -f $_;
+ diag "testing $_" if $ENV{'TEST_VERBOSE'};
+ check_callback( $_ ) and return;
+ $ok = 0;
+ diag "error in ${File::Find::name}:\n$@";
+ },
+}, 'html/Callbacks/');
+ok($ok, "all callbacks are ok");
+
+
+sub check_callback {
+ my $path = shift;
+ my ($comp, $callback) = ($path =~ m{^html/Callbacks/[^/]+/(.*)/([^/]+)$});
+
+ my $comp_path = "/opt/rt3/share/html/$comp";
+ $comp_path = "/opt/rt3/html/$comp" unless -e $comp_path;
+
+ open my $fh, '<', $comp_path or die "couldn't open '$comp_path': $!";
+ my $text = do { local $/; <$fh> };
+ close $fh;
+
+ if ( $callback eq 'Default' ) {
+ return $text =~ /\$m->callback/;
+ } else {
+ return $text =~ /CallbackName\s*=>\s*'$callback'/;
+ }
+
+ return 1;
+}
+
commit b59d969649ba1c348167db0579363adafe3f340b
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 11:54:53 2007 +0000
* fix test
diff --git a/t/rtir.t b/t/rtir.t
index 257f0ea..8be599e 100644
--- a/t/rtir.t
+++ b/t/rtir.t
@@ -3,21 +3,16 @@
use strict;
use warnings;
-
-use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
-
use Test::More;
-
-eval 'use RT::IR; 1' or plan skip_all => 'RTIR not installed';
-
-plan tests => 117;
-
-use HTTP::Cookies;
-
require "t/test_suite.pl";
+eval 'use RT::IR; 1' or plan skip_all => 'RTIR not installed';
+plan tests => 128;
+use_ok('RT::Extension::TicketLocking');
+create_user();
my $agent = default_agent();
+use HTTP::Cookies;
my $root = new RT::Test::Web;
$root->cookie_jar( HTTP::Cookies->new );
$root->login('root', 'password');
@@ -28,7 +23,10 @@ my $SUBJECT = "foo " . rand;
diag("Testing Incident locking") if $ENV{'TEST_VERBOSE'};
# Create an incident
-my $inc = create_incident($agent, {Subject => $SUBJECT, Content => "bla", Owner => 'Nobody in particular (Nobody)' });
+my $inc = create_incident($agent,
+ {Subject => $SUBJECT, Content => "bla",
+ Owner => 'Nobody in particular (Nobody)' }
+);
my $inc_obj = RT::Ticket->new(RT::SystemUser());
@@ -53,14 +51,16 @@ ok(($lock->Content->{'Type'} eq 'Hard'), "Lock is a Hard lock");
my $expire = RT->Config->Get('LockExpiry');
SKIP: {
- skip 'Not testing lock expiry--expiration feature turned off', 4 unless $expire;
+ skip 'Not testing lock expiry -- expiration feature turned off', 4 unless $expire;
+ skip 'Not testing lock expiry -- expiration time more than 30 sec.', 4 if $expire > 30;
+
+ diag "Sleep for $expire second(s) to make sure expiration works";
sleep $expire;
$agent->follow_link_ok({text => 'Display', n =>'1'}, "Going back to display page for Incident #$inc");
$agent->content_unlike(qr{<div class="locked-by-you">}, "Incident #$inc not locked anymore (lock expired)");
ok(!$inc_obj->Locked(), "Lock not in the database");
-
$agent->follow_link_ok({text => 'Lock', n => '1'}, "Followed 'Lock' link again");
}
@@ -337,6 +337,19 @@ $agent->form_number(3);
$agent->field('Owner', $nobody);
$agent->click('SaveChanges');
$agent->content_like(qr{<li>Owner changed from \w+ to Nobody</li>}, "Owner changed to Nobody");
+
+
+# create an incident to have at least one
+{
+ my $id = create_incident(
+ $agent,
+ { Subject => $SUBJECT },
+# { Constituency => $ir_obj->FirstCustomFieldValue('_RTIR_Constituency') },
+ );
+ ok $id, 'created an incident';
+}
+
+$agent->goto_ticket($report);
$agent->follow_link_ok({text => 'Take', n => '1'}, "Followed Take link again");
$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Got a lock from Taking");
sleep 5;
@@ -345,6 +358,7 @@ $agent->content_like(qr{<div class="locked-by-you">\s*You have had this ticket l
###Pick a ticket to link to (we don't really care which)
$agent->content =~ qr{<input type="radio" name="SelectedTicket" value="(\d+)"\s*/>}ims;
my $inc_to_link_to = $1;
+ok $inc_to_link_to, 'found id of an incident to link to';
$agent->form_number(3);
$agent->field('SelectedTicket', $inc_to_link_to);
$agent->click('LinkChild');
@@ -358,7 +372,7 @@ $agent->follow_link_ok({text => 'Lock', n => '1'}, "Hard locked to test multi-us
diag("Testing IR locking from other user's point of view");
-go_home($root);
+$root->get_ok( '/RTIR/index.html', 'go home');
display_ticket($root, $report);
$root->content_like(qr{<div class="locked">}, "IR #$report is locked by another");
$root->follow_link_ok({text => 'Break lock', n => '1'}, "Breaking lock on IR #$report");
commit e0913c0c56da7ac36d193b949fae40c005a8c773
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 12:23:41 2007 +0000
* cleanup items from TODO
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..f5029e9
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,18 @@
+---
+abstract: Enables users to place advisory locks on tickets
+author: Turner Hayes <thayes at bestpractical.com>
+distribution_type: module
+generated_by: Module::Install version 0.67
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: RT-Extension-TicketLocking
+no_index:
+ directory:
+ - html
+ - inc
+ - t
+requires:
+ Test::More: 0
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
index 913f683..8aa94fa 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,6 +5,25 @@ author ('Turner Hayes <thayes at bestpractical.com>');
version_from ('lib/RT/Extension/TicketLocking.pm');
abstract_from('lib/RT/Extension/TicketLocking.pm');
license('perl');
+
requires('Test::More');
-&WriteAll;
+{ # check RT version
+ my @v = split /\./, "$RT::VERSION";
+ unless ($v[0]>=3 && $v[1]>=7) {
+ die "this extension needs RT 3.7.0 at least, you have $RT::VERSION";
+ }
+}
+
+my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
+my $local_lib_path = "$RT::LocalPath/lib";
+unshift @INC, $local_lib_path, $lib_path;
+
+substitute( {
+ RT_LIB_PATH => join( ' ', $local_lib_path, $lib_path ),
+ },
+ 't/test_suite.pl',
+);
+
+
+WriteAll();
diff --git a/TODO b/TODO
index 055e18f..47d7ee0 100644
--- a/TODO
+++ b/TODO
@@ -4,8 +4,3 @@
** add description of portlet 'Element/MyLocks',
how to add to home page, how to setup config...
-* add check for RT version to Makefile.PL
-
-* use M::I::Substitute, in tests we need correct lib paths
-
-
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index ae565f4..1513848 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -40,7 +40,7 @@ sub RTx {
until ( eval { require RT; $RT::LocalPath } ) {
warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
$_ = $self->prompt("Path to your RT.pm:") or exit;
- push @INC, $_, "$_/rt3/lib", "$_/lib/rt3";
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
}
}
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..95ff9a7
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,128 @@
+#line 1
+package Module::Install::Substitute;
+
+use vars qw(@ISA);
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use strict;
+use warnings;
+
+$Module::Install::Substitute::VERSION = '0.02';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 64
+
+sub substitute
+{
+ my $self = shift;
+ $self->{__subst} = shift;
+ $self->{__option} = {};
+ if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+ my $opts = shift;
+ while( my ($k,$v) = each( %$opts ) ) {
+ $self->{__option}->{ lc( $k ) } = $v || '';
+ }
+ }
+ $self->_parse_options;
+
+ my @file = @_;
+ foreach my $f (@file) {
+ $self->_rewrite_file( $f );
+ }
+
+ return;
+}
+
+sub _parse_options
+{
+ my $self = shift;
+ my $cwd = Cwd::getcwd();
+ foreach my $t ( qw(from to) ) {
+ $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+ my $d = $self->{__option}->{$t};
+ die "Couldn't read directory '$d'" unless -d $d && -r _;
+ }
+}
+
+sub _rewrite_file
+{
+ my ($self, $file) = @_;
+ my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+ $source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+ unless( -f $source && -r _ ) {
+ print STDERR "Couldn't find file '$source'\n";
+ return;
+ }
+ my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+ return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+ my ($self, $source, $dest) = @_;
+
+ my $mode = (stat($source))[2];
+
+ open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+ print "Open input '$source' file for substitution\n";
+
+ my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+ $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+ close $sfh;
+
+ seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+ open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+ print "Open output '$dest' file for substitution\n";
+
+ while( <$tmpfh> ) {
+ print $dfh $_;
+ }
+ close $dfh;
+ chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+ my ($self, $in, $out, $replace) = @_;
+
+ my @queue = ();
+ my $subst = $self->{'__subst'};
+ my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+ while( my $str = <$in> ) {
+ if( $str =~ /^###\s*(before|replace|after)\: ?(.*)$/s ) {
+ my ($action, $nstr) = ($1,$2);
+ $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+ $action = 'before' if !$replace && $action eq 'replace';
+ if( $action eq 'before' ) {
+ die "no line before 'before' action" unless @queue;
+ # overwrite prev line;
+ pop @queue;
+ push @queue, $nstr;
+ push @queue, $str;
+ } elsif( $action eq 'replace' ) {
+ push @queue, $nstr;
+ } elsif( $action eq 'after' ) {
+ push @queue, $str;
+ push @queue, $nstr;
+ # skip one line;
+ <$in>;
+ }
+ } else {
+ push @queue, $str;
+ }
+ while( @queue > 3 ) {
+ print $out shift(@queue);
+ }
+ }
+ while( scalar @queue ) {
+ print $out shift(@queue);
+ }
+}
+
+1;
commit dbf61f1bfa127be339676f0a3d418565bdd6bc18
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 13:42:44 2007 +0000
* PODify docs/locking
** move docs into .pm
** split implementation details from user level docs
** add description of portlet 'Element/MyLocks',
how to add to home page, how to setup config...
diff --git a/TODO b/TODO
index 47d7ee0..e69de29 100644
--- a/TODO
+++ b/TODO
@@ -1,6 +0,0 @@
-* PODify docs/locking
-** move docs into .pm
-** split implementation details from user level docs
-** add description of portlet 'Element/MyLocks',
- how to add to home page, how to setup config...
-
diff --git a/docs/locking b/docs/locking
deleted file mode 100644
index 5170484..0000000
--- a/docs/locking
+++ /dev/null
@@ -1,78 +0,0 @@
-RT Locking
-----------
-
-- Locks can be of several different types. Current types are:
- - Hard (manual lock)
- - Take (results from Taking an Incident Report, removed when linked to an Incident)
- - This is only applicable within RTIR. If RTIR is not installed, this type will not
- be available.
- - Auto (default type, results from going to certain pages listed below)
-
-- Each type is associated with a priority. Current priorities are as follows, from highest priority to lowest:
- - Hard
- - Take (when applicable)
- - Auto
-
-- A lock can be initiated manually by clicking the "Lock" link on one of the pages for the ticket (hard lock)
-
-- A lock is created whenever a user performs an action on a ticket that takes multiple steps (auto lock) if a
- hard lock is not already in place for that ticket
-
- Locking Actions in RT:
- ----------------------
-
- - Comment
- - Reply
- - Resolve
-
-
- Locking Actions in RTIR:
- ------------------------
-
- - Edit
- - Split
- - Merge
- - Advanced
- - Reply
- - Resolve
- - Reject
- - Comment
- - Remove
-
-- A lock can be removed manually by clicking the "Unlock" link on one of the pages for the ticket (hard unlock)
-
-- An auto lock is removed once the user is done with whatever he was doing on the page (e.g., when he clicks
- "Save Changes" on the Edit page). It is also removed if the Unlock link is clicked from a page that generated
- an auto lock. Clicking "Unlock" will also remove the hard lock on the ticket, if there is one.
-
-- Locks are advisory: if a ticket is locked by one user, other users will be given a notification (in red) that another user has locked the ticket but they will still be allowed to edit and submit changes on the ticket.
-
-- Locks will remain in place until
- a) The user is done editing/replying/etc. (for auto locks, if there is no hard lock on the ticket)
- b) The user clicks the Unlock link
- c) The user logs out
- d) A configurable expiry period has elapsed (if the $LockExpiry config variable has been set to a true value)
-
-- When a user clicks the "Take" link for an RTIR Incident ticket, a Take lock is added. This lock will only be removed
- when the Incident is linked to a new or existing Investigation.
-
-- When a user locks a ticket (auto lock or hard lock), they are given a notification informing them of their lock (in some other color--currently green).
-
-- When a user unlocks a ticket (auto unlock or hard unlock), they are given a notification informing them that their
- lock has been removed, and how long they had the ticket locked for.
-
-- When a user accesses a page for a ticket that they have locked, they are presented with a notification informing them
- that they have the ticket locked, and how long they have had the ticket locked.
-
-- When a user accesses a page for a ticket that has been locked by another user, they are given a notification of the
- other user's lock, with the locking user's name and how long they have had it locked for.
-
-- When a locked ticket (hard or Take lock) is merged into another ticket, the ticket being merged into will get the lock
- type of the ticket being merged from. This lock shift is conditional upon priority, as usual--if the merged from
- ticket has a lock of a lower priority than the merged-to ticket, the merged-to ticket will retain its lock. If the
- merged-to ticket is locked by a different user, that user will retain the lock. Basically, the merged-to ticket will
- retain its lock if it is higher priority than the lock on the ticket being merged from.
-
-- When the expiration time has passed, the next time a user looks at the ticket (i.e., RT::Ticket::Locked() is called on it from
- a Display page or the like, or when the MyLocks portlet is rendered). The entry will not automatically be removed from the database
- (we'd need to set up a cron job for that), but this shouldn't matter since the lock will be removed when next observed.
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 4788cc0..1e4b649 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -57,6 +57,147 @@ our $VERSION = '0.01';
RT::Extension::TicketLocking - Enables users to place advisory locks on tickets
+=head1 DESCRIPTION
+
+Locks can be of several different types. Current types are:
+
+=over 4
+
+=item hard (manual) lock
+
+A lock can be initiated manually by clicking the "Lock" link on one of the pages
+for the ticket.
+
+=item take lock
+
+This is only applicable within RTIR. See L</RTIR> section below.
+
+=item auto lock
+
+A lock is created whenever a user performs an action on a ticket that takes
+multiple steps if a hard lock is not already in place for that ticket.
+
+An auto lock is removed once the user is done with whatever he was doing
+on the page (e.g., when he clicks "Save Changes" on the Edit page).
+It is also removed if the Unlock link is clicked from a page that generated
+an auto lock.
+
+Auto-lock is set for the following actions in RT:
+
+ - Comment
+ - Reply
+ - Resolve
+
+RTIR's user may find list of actions below.
+
+=back
+
+Locks are advisory: if a ticket is locked by one user, other users
+will be given a notification (in red) that another user has locked
+the ticket, with the locking user's name and how long he has had
+it locked for, but they will still be allowed to edit and submit
+changes on the ticket.
+
+When a user locks a ticket (auto lock or hard lock), they are given
+a notification informing them of their lock and how long they have
+had the ticket locked (in some other color - currently green).
+
+=head2 Removing locks
+
+Locks will remain in place until:
+
+=over 4
+
+=item * The user is done editing/replying/etc. (for auto locks, if
+there is no hard lock on the ticket)
+
+=item * A lock can be removed manually by clicking the "Unlock" link on one
+of the pages for the ticket. This removes B<any> type of lock.
+
+=item * The user logs out
+
+=item * A configurable expiry period has elapsed (if the $LockExpiry
+config variable has been set to a true value)
+
+=back
+
+When a user unlocks a ticket (auto unlock or hard unlock),
+they are given a notification informing them that their
+lock has been removed, and how long they had the ticket
+locked for.
+
+=head2 Merging tickets
+
+When a locked ticket (hard or take lock) is merged into another ticket,
+the ticket being merged into will get the lock type of the ticket being
+merged from. This lock shift is conditional upon priority, as
+usual - if the merged from ticket has a lock of a lower priority than
+the merged-to ticket, the merged-to ticket will retain its lock.
+If the merged-to ticket is locked by a different user, that user will
+retain the lock. Basically, the merged-to ticket will retain its lock
+if it is higher priority than the lock on the ticket being merged from.
+
+=head2 RTIR
+
+Within RTIR auto locks are applied for the following actions:
+
+ - Edit
+ - Split
+ - Merge
+ - Advanced
+ - Reply
+ - Resolve
+ - Reject
+ - Comment
+ - Remove
+
+As well, there is special type of lock implemented in RTIR. When a
+user clicks the "Take" link for an RTIR Incident ticket, a Take lock
+is added. This lock will only be removed when the IR is linked to
+a new or existing Incident. If RTIR is not installed, this type
+will not be available.
+
+=head1 CONFIGURATION
+
+=head2 LockExpiry option
+
+In the config you can set LockExpiry option to a number of seconds,
+for example:
+
+ Set( $LockExpiry, 5*60 ); # lock expires after five minutes
+
+=head2 Allowing users to use 'MyLocks' portlet
+
+Thei extension comes with a portlet users can place on thier home
+page RT's or RTIR's, to allow them to add this portlet admin have
+to place it in the list of allowed components.
+
+Using this portlet user can easily jump to locked tickets, remove
+particular lock or all locks at once.
+
+For 'RT at Glance':
+
+ Set($HomepageComponents, [qw(
+ MyLocks
+ ... list of another portlets ...
+ )]);
+
+For RTIR:
+ Set(@RTIR_HomepageComponents, qw(
+ MyLocks
+ ... list of another portlets ...
+ ));
+
+=head1 IMPLEMENTATION DETAILS
+
+Each type is associated with a priority. Current priorities are as follows,
+from highest priority to lowest:
+ - Hard
+ - Take (when applicable)
+ - Auto
+
+This allow us to store only one lock record with higher priority.
+
=cut
our @LockTypes = qw(Auto Hard);
commit af8f359bf4046289d0634c0a3cd3685777cc8ce4
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 13:57:46 2007 +0000
* incorporate docs in one place
diff --git a/README b/README
index 6b1b329..b7ac726 100644
--- a/README
+++ b/README
@@ -6,56 +6,15 @@ To install this module, run the following commands:
perl Makefile.PL
make
- make test
make install
+DOCUMENTAION
-To use this module, you must add the line
-
- use RT::Extension::TicketLocking;
-
-to the bottom of your RT_SiteConfig.pm file. You must also define a lock expiry (the longest time
-a lock can remain without being automatically removed, by adding a line like the following to your
-RT_SiteConfig.pm file:
-
- Set($LockExpiry, 300);
-
-Expiration time is measured in seconds. If you don't wish to have your locks automatically expire,
-simply set $LockExpiry to a false value.
-
-
-If you want the MyLocks portlet to be available from the RT at a Glance page, you will need to
-enable it with a line like this in your RT_SiteConfig.pm file
-
-Set($HomepageComponents, [qw(QuickCreate Quicksearch MyAdminQueues MySupportQueues MyReminders
- RefreshHomepage MyLocks)]);
-
-This is the default portlet list with MyLocks added to the end. People can then choose to add
-the portlet to their homepage in Preferences -> RT at a glance.
-
-
-If you are running RTIR, and want the portlet to be available from the RTIR home page, you will
-need to do something similar to set the RTIR_HomepageComponents array in your RTIR_Config.pm file,
-like this:
-
-Set(@RTIR_HomepageComponents, qw(
- QuickCreate
- Quicksearch
- MyAdminQueues
- MySupportQueues
- MyReminders
- /RTIR/Elements/NewReports
- /RTIR/Elements/UserDueIncidents
- /RTIR/Elements/NobodyDueIncidents
- /RTIR/Elements/DueIncidents
- /RTIR/Elements/QueueSummary
- RefreshHomepage
- MyLocks
-));
-
-This is the default RTIR portlet list with MyLocks added to the end. People can then choose to add
-the portlet to their homepage in Preferences -> RTIR Home.
+All documentation about this extension you can find in
+'lib/RT/Extension/TicketLocking.pm', use `perldoc` utility
+to read it.
+ perldoc lib/RT/Extension/TicketLocking.pm
COPYRIGHT AND LICENCE
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 1e4b649..7ea036f 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -162,32 +162,46 @@ will not be available.
=head2 LockExpiry option
In the config you can set LockExpiry option to a number of seconds,
+the longest time a lock can remain without being automatically removed,
for example:
Set( $LockExpiry, 5*60 ); # lock expires after five minutes
+If you don't wish to have your locks automatically expire, simply
+set $LockExpiry to a false (zero or undef) value.
+
=head2 Allowing users to use 'MyLocks' portlet
-Thei extension comes with a portlet users can place on thier home
-page RT's or RTIR's, to allow them to add this portlet admin have
-to place it in the list of allowed components.
+The extension comes with a portlet users can place on thier home
+page RT's or RTIR's. Using this portlet user can easily jump to
+locked tickets, remove particular lock or all locks at once.
-Using this portlet user can easily jump to locked tickets, remove
-particular lock or all locks at once.
+If you want the MyLocks portlet to be available then you have
+to place it in the list of allowed components.
-For 'RT at Glance':
+For RT:
Set($HomepageComponents, [qw(
MyLocks
... list of another portlets ...
)]);
-For RTIR:
+People can then choose to add the portlet to their homepage
+in Preferences -> 'RT at a glance'.
+
+If you are running RTIR, and want the portlet to be available
+from the RTIR home page, you will need to do something similar
+to set the RTIR_HomepageComponents array in your config file,
+like this:
+
Set(@RTIR_HomepageComponents, qw(
MyLocks
... list of another portlets ...
));
+People can then choose to add the portlet to their homepage
+in Preferences -> 'RTIR Home'.
+
=head1 IMPLEMENTATION DETAILS
Each type is associated with a priority. Current priorities are as follows,
commit dc2db92fcc4acc38d0550c0e90fd4145f82816cc
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 13:58:11 2007 +0000
* update manifest
diff --git a/MANIFEST b/MANIFEST
index 43be0e1..192d0af 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,4 @@
-docs/locking
+html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/BeforeActionList
@@ -53,12 +53,16 @@ inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/RTx.pm
+inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Extension/TicketLocking.pm
Makefile.PL
MANIFEST This list of files
+META.yml
README
+t/callbacks.t
t/rt.t
t/rtir.t
t/test_suite.pl
+TODO
commit 0b65d28a9af136b85ae1ff3c7a569463cff27d45
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 14:23:53 2007 +0000
* make test less strict to text
** 100% pass
diff --git a/t/rtir.t b/t/rtir.t
index 8be599e..4c5190c 100644
--- a/t/rtir.t
+++ b/t/rtir.t
@@ -250,7 +250,7 @@ $agent->form_number(3);
$agent->field("SelectedTicket", $ir_id2);
$agent->submit();
diag("Submitted Merge form") if $ENV{'TEST_VERBOSE'};
-$agent->content_like(qr{<div class="locked-by-you">\s*You have locked this ticket\.}ims, "Lock from $report moved to $ir_id2");
+$agent->content_like(qr{<div class="locked-by-you">}ims, "Lock from $report moved to $ir_id2");
$report = $ir_id2;
$agent->follow_link_ok({text => 'Unlock', n => '1'}, "Removing hard lock on IR $report");
commit d048f17dfc07fb138f6c8cc1af3fb67c2ce03323
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 14:25:23 2007 +0000
* use PassArguments instead of ARGSRef
diff --git a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
index f2fe01c..63ff257 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
+++ b/html/Callbacks/RT-Extension-TicketLocking/RTIR/Incident/Reply.html/BeforeDisplay
@@ -1,9 +1,9 @@
<%ARGS>
$Ticket
-$ARGSRef => undef
+$PassArguments => {}
</%ARGS>
<%INIT>
-my ($d) = $Ticket->Unlock();
-$$ARGSRef{'Duration'} = $d unless $$ARGSRef{'Duration'};
+my ($d) = $Ticket->Unlock;
+$PassArguments->{'Duration'} = $d unless $PassArguments->{'Duration'};
</%INIT>
commit a116e90de14bdff277e0980fd11914d0106092a6
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Aug 24 18:59:58 2007 +0000
* remove locks on logout
diff --git a/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
new file mode 100644
index 0000000..b0e737b
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
@@ -0,0 +1,3 @@
+<%INIT>
+$session{'CurrentUser'}->RemoveLocks;
+</%INIT>
commit aed6bf23d9d3b799739e00a2e11d932e80b3087e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 4 21:03:51 2007 +0000
* update manifest
diff --git a/MANIFEST b/MANIFEST
index 192d0af..7139002 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,5 @@
html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
+html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
html/Callbacks/RT-Extension-TicketLocking/RTIR/Display.html/BeforeActionList
commit 17be9636f6530ff77c6573d5bde3b2bd614d4a23
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 4 21:04:09 2007 +0000
* bump version
diff --git a/META.yml b/META.yml
index f5029e9..ff772ae 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.01
+version: 0.02
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 7ea036f..df79dc0 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ package RT::Ticket;
use strict;
use warnings;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 NAME
commit 756af11fb4fac64b963f42db635650f2f79fd2ab
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 4 22:31:41 2007 +0000
* define our own package as PAUSE's indexer is confused
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index df79dc0..10bedbc 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -46,11 +46,11 @@
#
# END BPS TAGGED BLOCK }}}
-package RT::Ticket;
-
use strict;
use warnings;
+package RT::Extension::TicketLocking;
+
our $VERSION = '0.02';
=head1 NAME
@@ -214,6 +214,8 @@ This allow us to store only one lock record with higher priority.
=cut
+package RT::Ticket;
+
our @LockTypes = qw(Auto Hard);
sub Locked {
commit ee09637befe0dcf1a4b9e1315ef84faf5188d674
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Sep 4 22:32:34 2007 +0000
* bump version 0.03
diff --git a/META.yml b/META.yml
index ff772ae..244a17f 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.02
+version: 0.03
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 10bedbc..984a86d 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 NAME
commit c9c577261c11cd28d7b3632c90753196de8d1125
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 11 20:35:44 2007 +0000
* load RT's modules we add methods to
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 984a86d..5eaad50 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -214,6 +214,7 @@ This allow us to store only one lock record with higher priority.
=cut
+use RT::Ticket;
package RT::Ticket;
our @LockTypes = qw(Auto Hard);
@@ -293,9 +294,7 @@ sub BreakLock {
}
-
-
-
+use RT::User;
package RT::User;
sub GetLocks {
commit 19c036cc44c6dfa738b23df8beb08d2daf3651fa
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 11 20:37:23 2007 +0000
* Default callback in the main autohandler doesn't applies to NoAuth path
diff --git a/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
index b0e737b..d8fc65f 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
+++ b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
@@ -1,3 +1,8 @@
<%INIT>
-$session{'CurrentUser'}->RemoveLocks;
+local $@;
+eval {
+ require RT::Extension::TicketLocking;
+ $session{'CurrentUser'}->UserObj->RemoveLocks;
+};
+$RT::Logger->error( $@ ) if $@;
</%INIT>
commit 2ac1fbba76f18d60ba3d854bbd4ad3bc9a47ba7a
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 11 20:44:15 2007 +0000
* remove if CurrentUser in the session hash has no id or
if there is no CurrentUser entry at all.
diff --git a/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
index d8fc65f..f22a239 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
+++ b/html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
@@ -1,8 +1,11 @@
<%INIT>
+return unless $session{'CurrentUser'} && $session{'CurrentUser'}->id;
+
local $@;
eval {
require RT::Extension::TicketLocking;
- $session{'CurrentUser'}->UserObj->RemoveLocks;
+ $session{'CurrentUser'}->RemoveLocks;
};
$RT::Logger->error( $@ ) if $@;
+return;
</%INIT>
commit 1a220ae0ff52e95def4eb58ad258ee757838a6b2
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 11 20:52:41 2007 +0000
* get rid of uninit warning
* cleanup code a little bit
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
index dee0d95..f9b10dd 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
@@ -1,17 +1,15 @@
+<& /Elements/ShowLock, %ARGS &>
<%ARGS>
$Duration => undef
$Actions => undef
</%ARGS>
-
<%INIT>
#A somewhat inelegant hack to get around /Ticket/Display.html's redirect, which nukes all
#variables except for id
unless($Duration) {
- my @msg = grep(qr{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions);
- my $msg = pop @msg;
- $msg =~ /(You have unlocked this ticket\.) It was locked for (\d+) seconds\./i;
- $ARGS{'Duration'} = $2 if $2 && $2 !~ /\./;
+ my $msg = (grep m{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions)[-1];
+ if ( $msg && $msg =~ /(You have unlocked this ticket\.) It was locked for (\d+) seconds\./i ) {
+ $ARGS{'Duration'} = $2 if $2 && $2 !~ /\./;
+ }
}
-$m->comp('/Elements/ShowLock', %ARGS);
-return;
</%INIT>
commit 442133b56785f13ee379a1021d881b956454284a
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 11 20:55:33 2007 +0000
* bump version
diff --git a/META.yml b/META.yml
index 244a17f..aac52be 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.03
+version: 0.04
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 5eaad50..c2e30ad 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
=head1 NAME
commit f4eef85e0eca7f1dfd435a19228648bb8cdbed83
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Oct 12 13:55:24 2007 +0000
* move css out of RTIR into the extension
diff --git a/MANIFEST b/MANIFEST
index 7139002..9beaf70 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,5 @@
html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
+html/Callbacks/RT-Extension-TicketLocking/Elements/Header/Head
html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeActionList
html/Callbacks/RT-Extension-TicketLocking/RTIR/Create.html/BeforeDisplay
@@ -47,6 +48,7 @@ html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/BeforeDisplay
html/Callbacks/RT-Extension-TicketLocking/Ticket/Update.html/Initial
html/Elements/MyLocks
html/Elements/ShowLock
+html/NoAuth/css/ticket-locking.css
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Elements/Header/Head b/html/Callbacks/RT-Extension-TicketLocking/Elements/Header/Head
new file mode 100644
index 0000000..52b9af1
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TicketLocking/Elements/Header/Head
@@ -0,0 +1 @@
+<link rel="stylesheet" href="<% $RT::WebPath %>/NoAuth/css/ticket-locking.css" type="text/css" media="all" />
diff --git a/html/NoAuth/css/ticket-locking.css b/html/NoAuth/css/ticket-locking.css
new file mode 100644
index 0000000..bc2266a
--- /dev/null
+++ b/html/NoAuth/css/ticket-locking.css
@@ -0,0 +1,21 @@
+div.locked-by-you {
+ width: 80%;
+ align: center;
+ border: 2px solid green;
+ padding: 1em;
+ margin: 1em;
+}
+
+.locked {
+ background: #ffcccc;
+ width: 80%;
+ align: center;
+ border: 2px solid red;
+ padding: 1em;
+ margin: 1em;
+}
+
+% $m->abort;
+<%INIT>
+$r->content_type('text/css');
+</%INIT>
commit 2323610b77cd5c7e58df86bc99ef8abdb6ef0aac
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Oct 12 13:56:54 2007 +0000
* bump version
diff --git a/META.yml b/META.yml
index aac52be..f5ff933 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.04
+version: 0.05
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index c2e30ad..49eb5a7 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
=head1 NAME
commit 68442d32b8ab29ca03c0f3b90a070bb57533c0c7
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 25 23:06:41 2007 +0000
* add LockPriority method
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 49eb5a7..edca904 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -217,7 +217,21 @@ This allow us to store only one lock record with higher priority.
use RT::Ticket;
package RT::Ticket;
-our @LockTypes = qw(Auto Hard);
+our @LockTypes = qw(Auto Take Hard);
+
+sub LockPriority {
+ my $self = shift;
+ my $type = shift;
+
+ my $priority;
+ for( my $i = 0; $i < scalar @LockTypes; $i++) {
+ $priority = $i if lc( $LockTypes[ $i ] ) eq lc( $type );
+ }
+ $RT::Logger->error( "There is no type '$type' in the list of lock types")
+ unless defined $priority;
+
+ return $priority || 0;
+}
sub Locked {
my $ticket = shift;
@@ -241,14 +255,8 @@ sub Lock {
if ( my $lock = $ticket->Locked() ) {
return undef if $lock->Content->{'User'} != $ticket->CurrentUser->id;
- my $LockType = $lock->Content->{'Type'};
- my $priority;
- my $LockPriority;
- for(my $i = 0; $i < scalar @LockTypes; $i++) {
- $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
- $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
- }
- return undef if $priority <= $LockPriority;
+ my $current_type = $lock->Content->{'Type'};
+ return undef if $ticket->LockPriority( $type ) <= $ticket->LockPriority( $current_type );
}
$ticket->Unlock($type); #Remove any existing locks (because this one has greater priority)
my $id = $ticket->id;
@@ -272,16 +280,13 @@ sub Unlock {
my $lock = $ticket->RT::Ticket::Locked();
return (undef, "This ticket was not locked.") unless $lock;
- return (undef, "You cannot unlock a ticket locked by another user.") unless $lock->Content->{User} == $ticket->CurrentUser->id;
-
- my $LockType = $lock->Content->{'Type'};
- my $priority;
- my $LockPriority;
- for(my $i = 0; $i < scalar @LockTypes; $i++) {
- $priority = $i if (lc $LockTypes[$i]) eq (lc $type);
- $LockPriority = $i if (lc $LockTypes[$i]) eq (lc $LockType);
- }
- return (undef, "There is a lock with a higher priority on this ticket.") if $priority < $LockPriority;
+ return (undef, "You cannot unlock a ticket locked by another user.")
+ unless $lock->Content->{User} == $ticket->CurrentUser->id;
+
+ my $current_type = $lock->Content->{'Type'};
+ return (undef, "There is a lock with a higher priority on this ticket.")
+ if $ticket->LockPriority( $type ) < $ticket->LockPriority( $current_type );
+
my $duration = time() - $lock->Content->{'Timestamp'};
$ticket->DeleteAttribute('RT_Lock');
return ($duration, "You have unlocked this ticket. It was locked for $duration seconds.");
commit ab5e6d7ffab6f2b0adbf34f233c8c47d367e73dc
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 25 23:08:04 2007 +0000
* get rid of uninit warnings
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
index f9b10dd..535c545 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Display.html/BeforeActionList
@@ -7,7 +7,7 @@ $Actions => undef
#A somewhat inelegant hack to get around /Ticket/Display.html's redirect, which nukes all
#variables except for id
unless($Duration) {
- my $msg = (grep m{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions)[-1];
+ my $msg = (grep defined && m{You have unlocked this ticket\. It was locked for (\d+) seconds\.}i, @$Actions)[-1];
if ( $msg && $msg =~ /(You have unlocked this ticket\.) It was locked for (\d+) seconds\./i ) {
$ARGS{'Duration'} = $2 if $2 && $2 !~ /\./;
}
diff --git a/html/Elements/ShowLock b/html/Elements/ShowLock
index 872f104..d3695ac 100644
--- a/html/Elements/ShowLock
+++ b/html/Elements/ShowLock
@@ -46,7 +46,9 @@
</div>
%}
<%INIT>
-grep {$_ =~ s/(You have unlocked this ticket\.) It was locked for \d+ seconds\./$1/i} @{$ARGS{'Actions'}} if $ARGS{'Actions'};
+foreach ( grep defined, @{ $ARGS{'Actions'} || [] } ) {
+ s/(You have unlocked this ticket\.) It was locked for \d+ seconds\./$1/i;
+}
if ( $Id ) {
$Ticket = LoadTicket($Id);
}
commit 0eed560088455322ca548c3e6dd1c5646cb8d62a
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Oct 25 23:10:51 2007 +0000
* bump version
diff --git a/META.yml b/META.yml
index f5ff933..9732437 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.05
+version: 0.06
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index edca904..039f2ae 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.05';
+our $VERSION = '0.06';
=head1 NAME
commit a8c550480619d2d4a63d934fa216adf1fbe1b045
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:04:28 2007 +0000
* minor
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 039f2ae..1a44c91 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -235,16 +235,16 @@ sub LockPriority {
sub Locked {
my $ticket = shift;
+
my $lock = $ticket->FirstAttribute('RT_Lock');
- if($lock) {
- my $duration = time() - $lock->Content->{'Timestamp'};
- my $expiry = RT->Config->Get('LockExpiry');
- if($expiry) {
- unless($duration < $expiry) {
- $ticket->DeleteAttribute('RT_Lock');
- undef $lock;
- }
- }
+ return $lock unless $lock;
+
+ return $lock unless my $expiry = RT->Config->Get('LockExpiry');
+
+ my $duration = time() - $lock->Content->{'Timestamp'};
+ unless ( $duration < $expiry ) {
+ $ticket->DeleteAttribute('RT_Lock');
+ undef $lock;
}
return $lock;
}
commit 0978b3f8f8847428a36cd5ee5f0f186ce2594ea1
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:15:34 2007 +0000
* check ACLs on hard locking
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 1a44c91..5e11dbe 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -218,6 +218,9 @@ use RT::Ticket;
package RT::Ticket;
our @LockTypes = qw(Auto Take Hard);
+our %CheckRightOnLock = (
+ Hard => 'ModifyTicket',
+);
sub LockPriority {
my $self = shift;
@@ -258,6 +261,11 @@ sub Lock {
my $current_type = $lock->Content->{'Type'};
return undef if $ticket->LockPriority( $type ) <= $ticket->LockPriority( $current_type );
}
+
+ if ( my $right = $CheckRightOnLock{ $type } ) {
+ return undef unless $ticket->CurrentUserHasRight('ModifyTicket');
+ }
+
$ticket->Unlock($type); #Remove any existing locks (because this one has greater priority)
my $id = $ticket->id;
my $username = $ticket->CurrentUser->Name;
commit 7268544164641d79b41f37502ae97d3852793116
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:17:07 2007 +0000
* don't show lock/inlock/break links if user has no rights
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
index 4ad85f2..654ad3d 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
@@ -5,6 +5,10 @@ $actions
<%INIT>
return unless $Ticket;
+if ( my $right = $RT::Ticket::CheckRightOnLock{'Hard'} ) {
+ return unless $Ticket->CurrentUserHasRight( $right );
+}
+
if (my $Lock = $Ticket->Locked()) {
if ($Lock->Content->{'User'} == $session{'CurrentUser'}->id) {
$actions->{'Lock'} = {
commit 376b3f65e73ffba4da5de2dfb90747bfa78258a7
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:20:06 2007 +0000
* doc updates
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 5e11dbe..c652a8f 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -66,7 +66,7 @@ Locks can be of several different types. Current types are:
=item hard (manual) lock
A lock can be initiated manually by clicking the "Lock" link on one of the pages
-for the ticket.
+for the ticket. However, hard locks are available only to users who can ModifyTicket.
=item take lock
@@ -117,7 +117,7 @@ of the pages for the ticket. This removes B<any> type of lock.
=item * The user logs out
=item * A configurable expiry period has elapsed (if the $LockExpiry
-config variable has been set to a true value)
+config variable has been set to a value greater than zero)
=back
commit c52daccc1a93600a31e40f35c1ac2e49b11dbc2b
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:20:35 2007 +0000
* indent
diff --git a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
index 654ad3d..72dd77e 100644
--- a/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
+++ b/html/Callbacks/RT-Extension-TicketLocking/Ticket/Elements/Tabs/Default
@@ -10,22 +10,21 @@ if ( my $right = $RT::Ticket::CheckRightOnLock{'Hard'} ) {
}
if (my $Lock = $Ticket->Locked()) {
- if ($Lock->Content->{'User'} == $session{'CurrentUser'}->id) {
- $actions->{'Lock'} = {
- path => "Ticket/Display.html?Lock=remove&id=" . $Ticket->Id,
- title => loc('Unlock')
- };
+ if ( $Lock->Content->{'User'} == $session{'CurrentUser'}->id ) {
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=remove&id=" . $Ticket->Id,
+ title => loc('Unlock')
+ };
} else {
- $actions->{'Lock'} = {
- path => "Ticket/Display.html?Lock=break&id=" . $Ticket->Id,
- title => loc('Break lock')
- };
-
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=break&id=" . $Ticket->Id,
+ title => loc('Break lock')
+ };
}
} else {
- $actions->{'Lock'} = {
- path => "Ticket/Display.html?Lock=add&id=" . $Ticket->Id,
- title => loc('Lock')
- };
+ $actions->{'Lock'} = {
+ path => "Ticket/Display.html?Lock=add&id=". $Ticket->Id,
+ title => loc('Lock')
+ };
}
</%INIT>
commit 237357ba67f504fab50680edfb641c80c382a462
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Fri Nov 2 20:37:56 2007 +0000
* bump version
diff --git a/META.yml b/META.yml
index 9732437..a6a782d 100644
--- a/META.yml
+++ b/META.yml
@@ -15,4 +15,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.06
+version: 0.07
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index c652a8f..6162ee0 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.06';
+our $VERSION = '0.07';
=head1 NAME
commit 7d20a796c44697cad3b303a35397866edf18f6c0
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sat Dec 15 00:32:53 2007 +0000
* remove empty TODO
diff --git a/TODO b/TODO
deleted file mode 100644
index e69de29..0000000
commit ddea65702a9dd201192c0542385f6ad81768338e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sat Dec 15 00:33:41 2007 +0000
* update M::I
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 9d13686..89a8653 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -28,7 +28,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.67';
+ $VERSION = '0.68';
}
# Whether or not inc::Module::Install is actually loaded, the
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 81fbcb6..49dfde6 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,7 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.67';
+$VERSION = '0.68';
# Suspend handler for "redefined" warnings
BEGIN {
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 5d1eab8..ec66fdb 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -11,7 +11,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index e884477..e0dd6db 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index fbc5cb2..17bd8a7 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -7,7 +7,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index b886046..f77d68a 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 612dc30..4f808c7 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index e1db381..078797c 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.67';
+ $VERSION = '0.68';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
commit e1a8f0c1bb3a5085d16b67c533ac8a188acb1ee3
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sat Dec 15 00:35:05 2007 +0000
* lib files tagged with bps's tag so license is GPL2
diff --git a/META.yml b/META.yml
index a6a782d..9aa6d0c 100644
--- a/META.yml
+++ b/META.yml
@@ -1,9 +1,10 @@
---
abstract: Enables users to place advisory locks on tickets
-author: Turner Hayes <thayes at bestpractical.com>
+author:
+ - Turner Hayes <thayes at bestpractical.com>
distribution_type: module
-generated_by: Module::Install version 0.67
-license: perl
+generated_by: Module::Install version 0.68
+license: GPL2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
diff --git a/Makefile.PL b/Makefile.PL
index 8aa94fa..b8ecff3 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -4,7 +4,7 @@ RTx('RT-Extension-TicketLocking');
author ('Turner Hayes <thayes at bestpractical.com>');
version_from ('lib/RT/Extension/TicketLocking.pm');
abstract_from('lib/RT/Extension/TicketLocking.pm');
-license('perl');
+license('GPL2');
requires('Test::More');
commit ad051d611ff9f081218b91aae27f57d861a0adde
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Feb 12 13:11:23 2008 +0000
* update MANIFEST, META and bump version for uploading to the CPAN
diff --git a/MANIFEST b/MANIFEST
index 9beaf70..1a04f06 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -68,4 +68,3 @@ t/callbacks.t
t/rt.t
t/rtir.t
t/test_suite.pl
-TODO
diff --git a/META.yml b/META.yml
index 9aa6d0c..e8af880 100644
--- a/META.yml
+++ b/META.yml
@@ -16,4 +16,4 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.07
+version: 0.08
diff --git a/README b/README
index b7ac726..3a42088 100644
--- a/README
+++ b/README
@@ -18,7 +18,7 @@ to read it.
COPYRIGHT AND LICENCE
-Copyright (C) 2007, Best Practical Solutions LLC.
+Copyright (C) 2007-2008, Best Practical Solutions LLC.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index 6162ee0..a56cfe1 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -51,7 +51,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.07';
+our $VERSION = '0.08';
=head1 NAME
commit cbac74791bcfd6c0bae32c1ebb73b0a11ce02647
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Mar 5 13:36:16 2008 +0000
* bump version and update distro's meta
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..8cef43f
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+
+0.09 Wed Mar 05 13:30:00 UTC 2007
+
+ * added this file
+ * updated some metadata
diff --git a/MANIFEST b/MANIFEST
index 1a04f06..3e55ee4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+Changes
html/Callbacks/RT-Extension-TicketLocking/autohandler/Default
html/Callbacks/RT-Extension-TicketLocking/Elements/Header/Head
html/Callbacks/RT-Extension-TicketLocking/NoAuth/Logout.html/BeforeSessionDelete
diff --git a/META.yml b/META.yml
index e8af880..2547eb5 100644
--- a/META.yml
+++ b/META.yml
@@ -16,4 +16,5 @@ no_index:
- t
requires:
Test::More: 0
-version: 0.08
+ perl: 5.8.3
+version: 0.09
diff --git a/Makefile.PL b/Makefile.PL
index b8ecff3..faf3755 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,20 +1,20 @@
use inc::Module::Install;
RTx('RT-Extension-TicketLocking');
-author ('Turner Hayes <thayes at bestpractical.com>');
-version_from ('lib/RT/Extension/TicketLocking.pm');
-abstract_from('lib/RT/Extension/TicketLocking.pm');
license('GPL2');
+all_from('lib/RT/Extension/TicketLocking.pm');
+abstract_from('lib/RT/Extension/TicketLocking.pm');
requires('Test::More');
{ # check RT version
my @v = split /\./, "$RT::VERSION";
- unless ($v[0]>=3 && $v[1]>=7) {
- die "this extension needs RT 3.7.0 at least, you have $RT::VERSION";
+ unless (($v[0]>=3 && $v[1]>=7) || $v[0]>3) {
+ die "Extension needs RT 3.7.0 at least, you have $RT::VERSION";
}
}
+
my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
my $local_lib_path = "$RT::LocalPath/lib";
unshift @INC, $local_lib_path, $lib_path;
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index a56cfe1..e116cbd 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -46,12 +46,13 @@
#
# END BPS TAGGED BLOCK }}}
+use v5.8.3;
use strict;
use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.08';
+our $VERSION = '0.09';
=head1 NAME
@@ -344,3 +345,10 @@ sub RemoveLocks {
}
1;
+
+=head1 AUTHOR
+
+Turner Hayes E<lt>thayes at bestpractical.comE<gt>
+
+=cut
+
commit 65ba06df76713d2b07e68bc21054f8fd6143a1c9
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Mon Sep 15 21:41:06 2008 +0000
* update M::I::RTx
* bump version and other things related to release
diff --git a/Changes b/Changes
index 8cef43f..c01a68a 100644
--- a/Changes
+++ b/Changes
@@ -1,4 +1,8 @@
+0.10 2008-09-15
+
+ * update installer
+
0.09 Wed Mar 05 13:30:00 UTC 2007
* added this file
diff --git a/META.yml b/META.yml
index 2547eb5..cbb4c64 100644
--- a/META.yml
+++ b/META.yml
@@ -1,20 +1,24 @@
----
-abstract: Enables users to place advisory locks on tickets
-author:
- - Turner Hayes <thayes at bestpractical.com>
+---
+abstract: 'Enables users to place advisory locks on tickets'
+author:
+ - 'Turner Hayes <thayes at bestpractical.com>'
+build_requires:
+ Test::More: 0
distribution_type: module
-generated_by: Module::Install version 0.68
+generated_by: 'Module::Install version 0.77'
license: GPL2
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
name: RT-Extension-TicketLocking
-no_index:
- directory:
+no_index:
+ directory:
+ - etc
- html
+ - po
+ - var
- inc
- t
-requires:
- Test::More: 0
+requires:
perl: 5.8.3
-version: 0.09
+version: 0.10
diff --git a/Makefile.PL b/Makefile.PL
index faf3755..f986ba5 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -3,9 +3,8 @@ use inc::Module::Install;
RTx('RT-Extension-TicketLocking');
license('GPL2');
all_from('lib/RT/Extension/TicketLocking.pm');
-abstract_from('lib/RT/Extension/TicketLocking.pm');
-requires('Test::More');
+build_requires('Test::More');
{ # check RT version
my @v = split /\./, "$RT::VERSION";
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 89a8653..eb449ca 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,20 +17,30 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.004;
+BEGIN {
+ require 5.004;
+}
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- # All Module::Install core packages now require synchronised versions.
- # This will be used to ensure we don't accidentally load old or
- # different versions of modules.
- # This is not enforced yet, but will be some time in the next few
- # releases once we can make sure it won't clash with custom
- # Module::Install extensions.
- $VERSION = '0.68';
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '0.77';
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
}
+
+
+
+
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
@@ -38,26 +48,29 @@ BEGIN {
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) {
- die <<"END_DIE";
+unless ( $INC{$file} ) { die <<"END_DIE" }
+
Please invoke ${\__PACKAGE__} with:
- use inc::${\__PACKAGE__};
+ use inc::${\__PACKAGE__};
not:
- use ${\__PACKAGE__};
+ use ${\__PACKAGE__};
END_DIE
-}
+
+
+
+
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
-if ( -f $0 and (stat($0))[9] > time ) {
- die << "END_DIE";
+if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
+
Your installer $0 has a modification time in the future.
This is known to create infinite loops in make.
@@ -65,115 +78,144 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
-}
+
+
+
+
+
+# Build.PL was formerly supported, but no longer is due to excessive
+# difficulty in implementing every single feature twice.
+if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+
+
+
+
+# To save some more typing in Module::Install installers, every...
+# use inc::Module::Install
+# ...also acts as an implicit use strict.
+$^H |= strict::bits(qw(refs subs vars));
+
+
+
+
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
-*inc::Module::Install::VERSION = *VERSION;
- at inc::Module::Install::ISA = __PACKAGE__;
-
sub autoload {
- my $self = shift;
- my $who = $self->_caller;
- my $cwd = Cwd::cwd();
- my $sym = "${who}::AUTOLOAD";
- $sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
- if ( my $code = $sym->{$pwd} ) {
- # delegate back to parent dirs
- goto &$code unless $cwd eq $pwd;
- }
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
- unshift @_, ($self, $1);
- goto &{$self->can('call')} unless uc($1) eq $1;
- };
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unless ( uc($1) eq $1 ) {
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ }
+ };
}
sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+
+ return 1;
}
sub preload {
- my ($self) = @_;
-
- unless ( $self->{extensions} ) {
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- );
- }
-
- my @exts = @{$self->{extensions}};
- unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
- }
-
- my %seen;
- foreach my $obj ( @exts ) {
- while (my ($method, $glob) = each %{ref($obj) . '::'}) {
- next unless $obj->can($method);
- next if $method =~ /^_/;
- next if $method eq uc($method);
- $seen{$method}++;
- }
- }
-
- my $who = $self->_caller;
- foreach my $name ( sort keys %seen ) {
- *{"${who}::$name"} = sub {
- ${"${who}::AUTOLOAD"} = "${who}::$name";
- goto &{"${who}::AUTOLOAD"};
- };
- }
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ my $admin = $self->{admin};
+ @exts = $admin->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
}
sub new {
- my ($class, %args) = @_;
-
- # ignore the prefix on extension modules built from top level.
- my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
- delete $args{prefix};
- }
-
- return $args{_self} if $args{_self};
-
- $args{dispatch} ||= 'Admin';
- $args{prefix} ||= 'inc';
- $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
- $args{bundle} ||= 'inc/BUNDLES';
- $args{base} ||= $base_path;
- $class =~ s/^\Q$args{prefix}\E:://;
- $args{name} ||= $class;
- $args{version} ||= $class->VERSION;
- unless ( $args{path} ) {
- $args{path} = $args{name};
- $args{path} =~ s!::!/!g;
- }
- $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
-
- bless( \%args, $class );
+ my ($class, %args) = @_;
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
}
sub call {
@@ -184,98 +226,144 @@ sub call {
}
sub load {
- my ($self, $method) = @_;
+ my ($self, $method) = @_;
- $self->load_extensions(
- "$self->{prefix}/$self->{path}", $self
- ) unless $self->{extensions};
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
- foreach my $obj (@{$self->{extensions}}) {
- return $obj if $obj->can($method);
- }
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
- my $admin = $self->{admin} or die <<"END_DIE";
+ my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
- my $obj = $admin->load($method, 1);
- push @{$self->{extensions}}, $obj;
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
- $obj;
+ $obj;
}
sub load_extensions {
- my ($self, $path, $top) = @_;
-
- unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
- unshift @INC, $self->{prefix};
- }
-
- foreach my $rv ( $self->find_extensions($path) ) {
- my ($file, $pkg) = @{$rv};
- next if $self->{pathnames}{$pkg};
-
- local $@;
- my $new = eval { require $file; $pkg->can('new') };
- unless ( $new ) {
- warn $@ if $@;
- next;
- }
- $self->{pathnames}{$pkg} = delete $INC{$file};
- push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
- }
-
- $self->{extensions} ||= [];
+ my ($self, $path, $top) = @_;
+
+ unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} = delete $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
}
sub find_extensions {
- my ($self, $path) = @_;
-
- my @found;
- File::Find::find( sub {
- my $file = $File::Find::name;
- return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
- my $subpath = $1;
- return if lc($subpath) eq lc($self->{dispatch});
-
- $file = "$self->{path}/$subpath.pm";
- my $pkg = "$self->{name}::$subpath";
- $pkg =~ s!/!::!g;
-
- # If we have a mixed-case package name, assume case has been preserved
- # correctly. Otherwise, root through the file to locate the case-preserved
- # version of the package name.
- if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
- open PKGFILE, "<$subpath.pm" or die "find_extensions: Can't open $subpath.pm: $!";
- my $in_pod = 0;
- while ( <PKGFILE> ) {
- $in_pod = 1 if /^=\w/;
- $in_pod = 0 if /^=cut/;
- next if ($in_pod || /^=cut/); # skip pod text
- next if /^\s*#/; # and comments
- if ( m/^\s*package\s+($pkg)\s*;/i ) {
- $pkg = $1;
- last;
- }
- }
- close PKGFILE;
- }
-
- push @found, [ $file, $pkg ];
- }, $path ) if -d $path;
-
- @found;
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
}
+
+
+
+
+#####################################################################
+# Utility Functions
+
sub _caller {
- my $depth = 0;
- my $call = caller($depth);
- while ( $call eq __PACKAGE__ ) {
- $depth++;
- $call = caller($depth);
- }
- return $call;
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+sub _read {
+ local *FH;
+ open FH, "< $_[0]" or die "open($_[0]): $!";
+ my $str = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $str;
+}
+
+sub _write {
+ local *FH;
+ open FH, "> $_[0]" or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
+ close FH or die "close($_[0]): $!";
+}
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+
+sub _version ($) {
+ my $s = shift || 0;
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
+ ) ? $_[0] : undef;
}
1;
+
+# Copyright 2008 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 49dfde6..433ebed 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,7 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.68';
+$VERSION = '0.77';
# Suspend handler for "redefined" warnings
BEGIN {
@@ -45,6 +45,8 @@ sub admin {
$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
}
+#line 101
+
sub is_admin {
$_[0]->admin->VERSION;
}
@@ -67,4 +69,4 @@ BEGIN {
1;
-#line 138
+#line 146
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index ec66fdb..9025607 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -11,7 +11,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.77';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
@@ -39,6 +39,7 @@ sub can_run {
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
@@ -79,4 +80,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 157
+#line 158
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index e0dd6db..d66aba5 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.77';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 17bd8a7..92cd1ef 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -7,7 +7,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.77';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
@@ -36,9 +36,9 @@ sub prompt {
sub makemaker_args {
my $self = shift;
- my $args = ($self->{makemaker_args} ||= {});
- %$args = ( %$args, @_ ) if @_;
- $args;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ %$args = ( %$args, @_ );
+ return $args;
}
# For mm args that take multiple space-seperated args,
@@ -63,18 +63,18 @@ sub build_subdirs {
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
- %$clean = (
+ %$clean = (
%$clean,
- FILES => join(' ', grep length, $clean->{FILES}, @_),
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
- my $self = shift;
+ my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
- %$realclean = (
+ %$realclean = (
%$realclean,
- FILES => join(' ', grep length, $realclean->{FILES}, @_),
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
@@ -104,8 +104,8 @@ sub tests_recursive {
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
- require File::Find;
%test_dir = ();
+ require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
@@ -114,10 +114,21 @@ sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
+ # Make sure we have a new enough
+ require ExtUtils::MakeMaker;
+
+ # MakeMaker can complain about module versions that include
+ # an underscore, even though its own version may contain one!
+ # Hence the funny regexp to get rid of it. See RT #35800
+ # for details.
+
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+
+ # Generate the
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
- $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args);
- $args->{VERSION} = $self->version || $self->determine_VERSION($args);
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
if ( $self->tests ) {
$args->{test} = { TESTS => $self->tests };
@@ -142,9 +153,12 @@ sub write {
map { @$_ }
map { @$_ }
grep $_,
- ($self->build_requires, $self->requires)
+ ($self->configure_requires, $self->build_requires, $self->requires)
);
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
@@ -167,7 +181,9 @@ sub write {
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
- $args{dist} = $preop;
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
@@ -205,7 +221,7 @@ sub fix_up_makefile {
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
- $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g;
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
@@ -234,4 +250,4 @@ sub postamble {
__END__
-#line 363
+#line 379
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index f77d68a..397fb97 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,63 +6,145 @@ use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
- $VERSION = '0.68';
+ $VERSION = '0.77';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
my @scalar_keys = qw{
- name module_name abstract author version license
- distribution_type perl_version tests installdirs
+ name
+ module_name
+ abstract
+ author
+ version
+ distribution_type
+ tests
+ installdirs
};
my @tuple_keys = qw{
- build_requires requires recommends bundles
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
};
-sub Meta { shift }
-sub Meta_ScalarKeys { @scalar_keys }
-sub Meta_TupleKeys { @tuple_keys }
-
-foreach my $key (@scalar_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}{$key} if defined wantarray and !@_;
- $self->{values}{$key} = shift;
- return $self;
- };
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+sub Meta { shift }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}{$key} if defined wantarray and !@_;
+ $self->{values}{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}{resources} };
+ }
+ return $self->{values}{resources}{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+sub requires {
+ my $self = shift;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @{ $self->{values}{requires} }, [ $module, $version ];
+ }
+ $self->{values}{requires};
+}
+
+sub build_requires {
+ my $self = shift;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @{ $self->{values}{build_requires} }, [ $module, $version ];
+ }
+ $self->{values}{build_requires};
+}
+
+sub configure_requires {
+ my $self = shift;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @{ $self->{values}{configure_requires} }, [ $module, $version ];
+ }
+ $self->{values}{configure_requires};
+}
+
+sub recommends {
+ my $self = shift;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @{ $self->{values}{recommends} }, [ $module, $version ];
+ }
+ $self->{values}{recommends};
}
-foreach my $key (@tuple_keys) {
- *$key = sub {
- my $self = shift;
- return $self->{values}{$key} unless @_;
-
- my @rv;
- while (@_) {
- my $module = shift or last;
- my $version = shift || 0;
- if ( $module eq 'perl' ) {
- $version =~ s{^(\d+)\.(\d+)\.(\d+)}
- {$1 + $2/1_000 + $3/1_000_000}e;
- $self->perl_version($version);
- next;
- }
- my $rv = [ $module, $version ];
- push @rv, $rv;
- }
- push @{ $self->{values}{$key} }, @rv;
- @rv;
- };
+sub bundles {
+ my $self = shift;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @{ $self->{values}{bundles} }, [ $module, $version ];
+ }
+ $self->{values}{bundles};
}
-# configure_requires is currently a null-op
-sub configure_requires { 1 }
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}{resources} ||= [];
+ push @{ $self->{values}{resources} }, [ $name, $value ];
+ }
+ $self->{values}{resources};
+}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
-sub test_requires { shift->build_requires(@_) }
-sub install_requires { shift->build_requires(@_) }
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
@@ -71,266 +153,348 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub sign {
- my $self = shift;
- return $self->{'values'}{'sign'} if defined wantarray and ! @_;
- $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
- return $self;
+ my $self = shift;
+ return $self->{values}{sign} if defined wantarray and ! @_;
+ $self->{values}{sign} = ( @_ ? $_[0] : 1 );
+ return $self;
}
sub dynamic_config {
my $self = shift;
unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
+ warn "You MUST provide an explicit true/false value to dynamic_config\n";
return $self;
}
- $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
- return $self;
+ $self->{values}{dynamic_config} = $_[0] ? 1 : 0;
+ return 1;
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+ # numbers (eg, 5.006001 or 5.008009).
+
+ $version =~ s/^(\d+)\.(\d+)\.(\d+)$/sprintf("%d.%03d%03d",$1,$2,$3)/e;
+
+ $version =~ s/_.+$//;
+ $version = $version + 0; # Numify
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+ $self->{values}{perl_version} = $version;
+ return 1;
+}
+
+sub license {
+ my $self = shift;
+ return $self->{values}{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $self->{values}{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license eq 'perl' ) {
+ $self->resources( license => 'http://dev.perl.org/licenses/' );
+ }
+
+ return 1;
}
sub all_from {
- my ( $self, $file ) = @_;
-
- unless ( defined($file) ) {
- my $name = $self->name
- or die "all_from called with no args without setting name() first";
- $file = join('/', 'lib', split(/-/, $name)) . '.pm';
- $file =~ s{.*/}{} unless -e $file;
- die "all_from: cannot find $file from $name" unless -e $file;
- }
-
- $self->version_from($file) unless $self->version;
- $self->perl_version_from($file) unless $self->perl_version;
-
- # The remaining probes read from POD sections; if the file
- # has an accompanying .pod, use that instead
- my $pod = $file;
- if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
- $file = $pod;
- }
-
- $self->author_from($file) unless $self->author;
- $self->license_from($file) unless $self->license;
- $self->abstract_from($file) unless $self->abstract;
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless $self->author;
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
}
sub provides {
- my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
- %$provides = (%$provides, @_) if @_;
- return $provides;
+ my $self = shift;
+ my $provides = ( $self->{values}{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
}
sub auto_provides {
- my $self = shift;
- return $self unless $self->is_admin;
-
- unless (-e 'MANIFEST') {
- warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
- return $self;
- }
-
- # Avoid spurious warnings as we are not checking manifest here.
-
- local $SIG{__WARN__} = sub {1};
- require ExtUtils::Manifest;
- local *ExtUtils::Manifest::manicheck = sub { return };
-
- require Module::Build;
- my $build = Module::Build->new(
- dist_name => $self->name,
- dist_version => $self->version,
- license => $self->license,
- );
- $self->provides(%{ $build->find_dist_packages || {} });
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
- my $self = shift;
- my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
-
- my $mods;
-
- if ( @_ == 1 and ref( $_[0] ) ) {
- # The user used ->feature like ->features by passing in the second
- # argument as a reference. Accomodate for that.
- $mods = $_[0];
- } else {
- $mods = \@_;
- }
-
- my $count = 0;
- push @$features, (
- $name => [
- map {
- ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
- : @$_
- : $_
- } @$mods
- ]
- );
-
- return @$features;
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
}
sub features {
- my $self = shift;
- while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
- $self->feature( $name, @$mods );
- }
- return $self->{values}->{features}
- ? @{ $self->{values}->{features} }
- : ();
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}{features}
+ ? @{ $self->{values}{features} }
+ : ();
}
sub no_index {
- my $self = shift;
- my $type = shift;
- push @{ $self->{values}{no_index}{$type} }, @_ if $type;
- return $self->{values}{no_index};
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}{no_index}{$type} }, @_ if $type;
+ return $self->{values}{no_index};
}
sub read {
- my $self = shift;
- $self->include_deps( 'YAML', 0 );
-
- require YAML;
- my $data = YAML::LoadFile('META.yml');
-
- # Call methods explicitly in case user has already set some values.
- while ( my ( $key, $value ) = each %$data ) {
- next unless $self->can($key);
- if ( ref $value eq 'HASH' ) {
- while ( my ( $module, $version ) = each %$value ) {
- $self->can($key)->($self, $module => $version );
- }
- }
- else {
- $self->can($key)->($self, $value);
- }
- }
- return $self;
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
}
sub write {
- my $self = shift;
- return $self unless $self->is_admin;
- $self->admin->write_meta;
- return $self;
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
}
sub version_from {
- my ( $self, $file ) = @_;
- require ExtUtils::MM_Unix;
- $self->version( ExtUtils::MM_Unix->parse_version($file) );
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
}
sub abstract_from {
- my ( $self, $file ) = @_;
- require ExtUtils::MM_Unix;
- $self->abstract(
- bless(
- { DISTNAME => $self->name },
- 'ExtUtils::MM_Unix'
- )->parse_abstract($file)
- );
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
}
-sub _slurp {
- my ( $self, $file ) = @_;
-
- local *FH;
- open FH, "< $file" or die "Cannot open $file.pod: $!";
- do { local $/; <FH> };
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
}
sub perl_version_from {
- my ( $self, $file ) = @_;
-
- if (
- $self->_slurp($file) =~ m/
- ^
- use \s*
- v?
- ([\d_\.]+)
- \s* ;
- /ixms
- )
- {
- my $v = $1;
- $v =~ s{_}{}g;
- $self->perl_version($1);
- }
- else {
- warn "Cannot determine perl version info from $file\n";
- return;
- }
+ my $self = shift;
+ if (
+ Module::Install::_read($_[0]) =~ m/
+ ^
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
}
sub author_from {
- my ( $self, $file ) = @_;
- my $content = $self->_slurp($file);
- if ($content =~ m/
- =head \d \s+ (?:authors?)\b \s*
- ([^\n]*)
- |
- =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
- .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
- ([^\n]*)
- /ixms) {
- my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
- $self->author($author);
- }
- else {
- warn "Cannot determine author info from $file\n";
- }
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
}
sub license_from {
- my ( $self, $file ) = @_;
-
- if (
- $self->_slurp($file) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms
- )
- {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser public license' => 'gpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- if ( $osi and $license_text =~ /All rights reserved/i ) {
- warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
+ my $self = shift;
+ if (
+ Module::Install::_read($_[0]) =~ m/
+ (
+ =head \d \s+
+ (?:licen[cs]e|licensing|copyright|legal)\b
+ .*?
+ )
+ (=head\\d.*|=cut.*|)
+ \z
+ /ixms ) {
+ my $license_text = $1;
+ my @phrases = (
+ 'under the same (?:terms|license) as perl itself' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s{\s+}{\\s+}g;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ if ( $osi and $license_text =~ /All rights reserved/i ) {
+ print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n";
+ }
+ $self->license($license);
+ return 1;
+ }
}
- $self->license($license);
- return 1;
- }
- }
- }
-
- warn "Cannot determine license info from $file\n";
- return 'unknown';
+ }
+
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g;
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than on rt.cpan.org link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub install_script {
+ my $self = shift;
+ my $args = $self->makemaker_args;
+ my $exe = $args->{EXE_FILES} ||= [];
+ foreach ( @_ ) {
+ if ( -f $_ ) {
+ push @$exe, $_;
+ } elsif ( -d 'script' and -f "script/$_" ) {
+ push @$exe, "script/$_";
+ } else {
+ die("Cannot find script '$_'");
+ }
+ }
}
1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 1513848..2028f5e 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -1,16 +1,26 @@
#line 1
package Module::Install::RTx;
-use Module::Install::Base; @ISA = qw(Module::Install::Base);
-
-$Module::Install::RTx::VERSION = '0.11';
+use 5.008;
use strict;
+use warnings;
+no warnings 'once';
+
+use Module::Install::Base;
+use base 'Module::Install::Base';
+our $VERSION = '0.23';
+
use FindBin;
-use File::Glob ();
+use File::Glob ();
use File::Basename ();
+my @DIRS = qw(etc lib html bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
sub RTx {
- my ($self, $name) = @_;
+ my ( $self, $name ) = @_;
+
+ my $original_name = $name;
my $RTx = 'RTx';
$RTx = $1 if $name =~ s/^(\w+)-//;
my $fname = $name;
@@ -18,61 +28,85 @@ sub RTx {
$self->name("$RTx-$name")
unless $self->name;
+ $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ unless $self->version;
$self->abstract("RT $name Extension")
unless $self->abstract;
- $self->version_from (-e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm")
- unless $self->version;
my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
- my $prefix = $ENV{PREFIX};
- @ARGV = grep { /PREFIX=(.*)/ ? (($prefix = $1), 0) : 1 } @ARGV;
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
if ($prefix) {
$RT::LocalPath = $prefix;
$INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
- }
- else {
+ } else {
local @INC = (
@INC,
- $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : (),
- map {( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )} grep $_, @prefixes
+ $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
+ @prefixes
);
until ( eval { require RT; $RT::LocalPath } ) {
- warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
$_ = $self->prompt("Path to your RT.pm:") or exit;
push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
}
}
- my $lib_path = File::Basename::dirname($INC{'RT.pm'});
- print "Using RT configurations from $INC{'RT.pm'}:\n";
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ my $local_lib_path = "$RT::LocalPath/lib";
+ print "Using RT configuration from $INC{'RT.pm'}:\n";
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
- $RT::LocalVarPath ||= $RT::VarPath;
- $RT::LocalPoPath ||= $RT::LocalLexiconPath;
- $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
- my %path;
my $with_subdirs = $ENV{WITH_SUBDIRS};
- @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? (($with_subdirs = $1), 0) : 1 } @ARGV;
- my %subdirs = map { $_ => 1 } split(/\s*,\s*/, $with_subdirs);
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
+ }
- foreach (qw(bin etc html po sbin var)) {
- next unless -d "$FindBin::Bin/$_";
- next if %subdirs and !$subdirs{$_};
- $self->no_index( directory => $_ );
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
- no strict 'refs';
- my $varname = "RT::Local" . ucfirst($_) . "Path";
- $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
}
- $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
- my $args = join(', ', map "q($_)", %path);
- $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
- print "./$_\t=> $path{$_}\n" for sort keys %path;
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
- if (my @dirs = map { (-D => $_) } grep $path{$_}, qw(bin html sbin)) {
- my @po = map { (-o => $_) } grep -f, File::Glob::bsd_glob("po/*.po");
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
+ File::Glob::bsd_glob("po/*.po");
$self->postamble(<< ".") if @po;
lexicons ::
\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
@@ -84,56 +118,57 @@ install ::
\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
.
- if ($path{var} and -d $RT::MasonDataDir) {
- my ($uid, $gid) = (stat($RT::MasonDataDir))[4, 5];
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
$postamble .= << ".";
\t\$(NOECHO) chown -R $uid:$gid $path{var}
.
}
my %has_etc;
- if (File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*")) {
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
+
# got schema, load factory module
$has_etc{schema}++;
$self->load('RTxFactory');
$self->postamble(<< ".");
factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
.
}
- if (File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*")) {
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
$has_etc{acl}++;
}
- if (-e 'etc/initialdata') {
- $has_etc{initialdata}++;
- }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
$self->postamble("$postamble\n");
- if (%subdirs and !$subdirs{'lib'}) {
- $self->makemaker_args(
- PM => { "" => "" },
- )
- }
- else {
- $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ unless ( $subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
}
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
if (%has_etc) {
$self->load('RTxInitDB');
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
@@ -141,7 +176,7 @@ dropdb ::
}
sub RTxInit {
- unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+ unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
require RT;
RT::LoadConfig();
RT::ConnectToDatabase();
@@ -153,6 +188,4 @@ sub RTxInit {
__END__
-#line 220
-
-#line 241
+#line 302
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
index 95ff9a7..56af7fe 100644
--- a/inc/Module/Install/Substitute.pm
+++ b/inc/Module/Install/Substitute.pm
@@ -1,19 +1,20 @@
#line 1
package Module::Install::Substitute;
-use vars qw(@ISA);
-use Module::Install::Base; @ISA = qw(Module::Install::Base);
-
use strict;
use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
-$Module::Install::Substitute::VERSION = '0.02';
+our $VERSION = '0.03';
require File::Temp;
require File::Spec;
require Cwd;
-#line 64
+#line 89
sub substitute
{
@@ -94,11 +95,12 @@ sub __process_streams
my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
while( my $str = <$in> ) {
- if( $str =~ /^###\s*(before|replace|after)\: ?(.*)$/s ) {
+ if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
my ($action, $nstr) = ($1,$2);
$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
- $action = 'before' if !$replace && $action eq 'replace';
+ die "Replace action is bad idea for situations when dest is equal to source"
+ if $replace && $action eq 'replace';
if( $action eq 'before' ) {
die "no line before 'before' action" unless @queue;
# overwrite prev line;
@@ -126,3 +128,4 @@ sub __process_streams
}
1;
+
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 4f808c7..cff76a2 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -4,11 +4,11 @@ package Module::Install::Win32;
use strict;
use Module::Install::Base;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.68';
- $ISCORE = 1;
+ $VERSION = '0.77';
@ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
@@ -16,7 +16,7 @@ sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
-
+
require Config;
return unless (
$^O eq 'MSWin32' and
@@ -38,8 +38,7 @@ sub check_nmake {
remove => 1,
);
- if (!$rv) {
- die <<'END_MESSAGE';
+ die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
@@ -59,7 +58,7 @@ You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
- }
+
}
1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 078797c..f35620f 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -4,40 +4,37 @@ package Module::Install::WriteAll;
use strict;
use Module::Install::Base;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.68';
- $ISCORE = 1;
+ $VERSION = '0.77';
@ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
}
sub WriteAll {
- my $self = shift;
- my %args = (
- meta => 1,
- sign => 0,
- inline => 0,
- check_nmake => 1,
- @_
- );
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->Meta->write if $args{meta};
+ $self->admin->WriteAll(%args) if $self->is_admin;
- $self->sign(1) if $args{sign};
- $self->Meta->write if $args{meta};
- $self->admin->WriteAll(%args) if $self->is_admin;
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ $self->makemaker_args( PL_FILES => {} );
+ }
- if ( $0 =~ /Build.PL$/i ) {
- $self->Build->write;
- } else {
- $self->check_nmake if $args{check_nmake};
- unless ( $self->makemaker_args->{'PL_FILES'} ) {
- $self->makemaker_args( PL_FILES => {} );
- }
- if ($args{inline}) {
- $self->Inline->write;
- } else {
- $self->Makefile->write;
- }
- }
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
}
1;
diff --git a/lib/RT/Extension/TicketLocking.pm b/lib/RT/Extension/TicketLocking.pm
index e116cbd..4f460dc 100644
--- a/lib/RT/Extension/TicketLocking.pm
+++ b/lib/RT/Extension/TicketLocking.pm
@@ -52,7 +52,7 @@ use warnings;
package RT::Extension::TicketLocking;
-our $VERSION = '0.09';
+our $VERSION = '0.10';
=head1 NAME
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list