[Bps-public-commit] RT-Extension-RepliesToResolved branch, master, updated. 71335ccb35565f107cb4508c290ce374bda41efe
Kevin Falcone
falcone at bestpractical.com
Fri Nov 9 18:04:18 EST 2012
The branch, master has been updated
via 71335ccb35565f107cb4508c290ce374bda41efe (commit)
via ebfbe330a716bd67890024ff1943e57c82ba8b6f (commit)
via b818243db4f671e6c2973566049aac902d1441f7 (commit)
via 1c3d1545eb5c9acf7fffc21d6915a376838ea1ee (commit)
via 191479d2bccbd9bb7e6e8d3ebf2851d8ffdb4aed (commit)
via 4f654c3c73a8a53116a10bccd3a8ab0fdfcd4161 (commit)
via 1287066a5c2075499bf22c49109675e0b9eb88ed (commit)
via d7157d857ef2d6b694800751682061eb0814d654 (commit)
via 8bb4e8779f984983c6707a91de87594cee10fc42 (commit)
via 7d77afe49d301c21f91c77ecbecfb2d57203ea53 (commit)
via 81ba7e33b4e48ad088be9a3728acaede68a96a43 (commit)
via e37afe4f8378500828f43302c02d43c91906062c (commit)
via 28ab105f056b27709efb62010106492faba6fcdd (commit)
from 9ef94f226c93a8746609206361d5a4db690a39b7 (commit)
Summary of changes:
MANIFEST | 4 ++
META.yml | 1 +
README | 62 ++++++++++++++----
etc/RepliesToResolved_Config.pm | 51 +++++++++++++++
etc/initialdata | 14 ++++
inc/Module/Install/RTx.pm | 2 +-
inc/Module/Install/RTx/Factory.pm | 46 +++++++++++++
inc/Module/Install/ReadmeFromPod.pm | 2 +-
lib/RT/Action/LinkWasReplyTo.pm | 53 +++++++++++++++
lib/RT/Extension/RepliesToResolved.pm | 120 ++++++++++++++++++++++++++++------
10 files changed, 319 insertions(+), 36 deletions(-)
create mode 100644 etc/RepliesToResolved_Config.pm
create mode 100644 etc/initialdata
create mode 100644 inc/Module/Install/RTx/Factory.pm
create mode 100644 lib/RT/Action/LinkWasReplyTo.pm
- Log -----------------------------------------------------------------
commit 28ab105f056b27709efb62010106492faba6fcdd
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Nov 6 19:29:22 2012 -0500
This should be a package declaration, not a use statement.
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index 5cb8601..31b755c 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -1,6 +1,6 @@
use 5.008003; use strict; use warnings;
-use RT::Extension::RepliesToResolved;
+package RT::Extension::RepliesToResolved;
our $VERSION = '0.01';
@@ -85,4 +85,4 @@ Under the same terms as perl itself.
=cut
-1;
\ No newline at end of file
+1;
commit e37afe4f8378500828f43302c02d43c91906062c
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Tue Oct 16 21:03:27 2012 +0100
Initial implementation of configurable timelimit
There's a default limit, and also a per-queue time limit
diff --git a/etc/RepliesToResolved_Config.pm b/etc/RepliesToResolved_Config.pm
new file mode 100644
index 0000000..c86abbd
--- /dev/null
+++ b/etc/RepliesToResolved_Config.pm
@@ -0,0 +1,9 @@
+package RT;
+
+Set(%RepliesToResolved,
+ default => {
+ 'reopen-timelimit' => 7,
+ },
+);
+
+
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index 31b755c..ec9a358 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -49,6 +49,20 @@ Register plugin in F<RT_SiteConfig.pm>:
=cut
+sub RemoveSubjectTags {
+ my $subject = shift;
+ my $rtname = RT->Config->Get('rtname');
+ my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
+
+ if ( $subject !~ s/\[$test_name\s+\#\d+\s*\]//i ) {
+ foreach my $tag ( RT->System->SubjectTag ) {
+ next unless $subject =~ s/\[\Q$tag\E\s+\#\d+\s*\]//i;
+ last;
+ }
+ }
+ return $subject;
+}
+
require RT::Interface::Email;
package RT::Interface::Email;
@@ -57,6 +71,8 @@ package RT::Interface::Email;
or die "It's not RT 4.0.7, you have to patch this RT."
." Read documentation for RT::Extension::RepliesToResolved";
+ no warnings qw(redefine);
+
*ExtractTicketId = sub {
my $entity = shift;
@@ -68,8 +84,24 @@ package RT::Interface::Email;
return $id unless $ticket->id;
if ( $ticket->Status eq 'resolved' ) {
- $RT::Logger->info("A reply to resolved ticket #". $ticket->id .", creating a new ticket");
- return undef;
+ my $r2r_config = RT->Config->Get('RepliesToResolved');
+ my $reopen_timelimit = $r2r_config->{'default'}->{'reopen-timelimit'} || 0;
+ if (exists($r2r_config->{$ticket->QueueObj->Name})) {
+ $reopen_timelimit = $r2r_config->{$ticket->QueueObj->Name}->{'reopen-timelimit'};
+ }
+
+ # If the timelimit is undef, follow normal RT behaviour
+ return $id unless defined($reopen_timelimit);
+
+ if ($ticket->ResolvedObj->Diff()/-86400 > $reopen_timelimit) {
+
+ $RT::Logger->info("A reply to resolved ticket #". $ticket->id .", creating a new ticket");
+
+ $entity->head->set("X-RT-Was-Reply-To" => Encode::encode_utf8($ticket->id));
+ my $subject = $entity->head->get('Subject') || '';
+ $entity->head->set('Subject' => RT::Extension::RepliesToResolved::RemoveSubjectTags($subject));
+ return undef;
+ }
}
return $id;
};
@@ -78,6 +110,7 @@ package RT::Interface::Email;
=head1 AUTHOR
Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
+Tim Cutts E<lt>tjrc at sanger.ac.ukE<gt>
=head1 LICENSE
commit 81ba7e33b4e48ad088be9a3728acaede68a96a43
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Wed Oct 17 00:33:38 2012 +0100
Implemented Scrip to create parent-child link
Uses the X-RT-Was-Reply-To header to create a parent-child link between
the new ticket and the old resolved ticket.
diff --git a/META.yml b/META.yml
index e8dfcfb..7d36723 100644
--- a/META.yml
+++ b/META.yml
@@ -16,6 +16,7 @@ meta-spec:
name: RT-Extension-RepliesToResolved
no_index:
directory:
+ - etc
- inc
requires:
perl: 5.8.3
diff --git a/README b/README
index 5a787c8..2ecb6da 100644
--- a/README
+++ b/README
@@ -23,6 +23,7 @@ INSTALLATION
perl Makefile.PL
make
make install
+ make initdb
Register plugin in RT_SiteConfig.pm:
@@ -32,7 +33,7 @@ INSTALLATION
));
AUTHOR
- Ruslan Zakirov <ruz at bestpractical.com>
+ Ruslan Zakirov <ruz at bestpractical.com> Tim Cutts <tjrc at sanger.ac.uk>
LICENSE
Under the same terms as perl itself.
diff --git a/etc/initialdata b/etc/initialdata
new file mode 100644
index 0000000..6e52061
--- /dev/null
+++ b/etc/initialdata
@@ -0,0 +1,14 @@
+
+ at ScripActions = (
+
+ { Name => 'Link to old resolved ticket', # loc
+ Description => 'Use the X-RT-Was-Reply-To header to create a link' , # loc
+ ExecModule => 'LinkWasReplyTo' },
+);
+
+ at Scrips = (
+ { Description => 'On Create, Link To Resolved Tickets',
+ ScripCondition => 'On Create',
+ ScripAction => 'Link to old resolved ticket',
+ Template => 'Blank' },
+);
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 2eba7ad..73b9cda 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.29_02';
+our $VERSION = '0.29';
use FindBin;
use File::Glob ();
@@ -129,7 +129,18 @@ install ::
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"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+
+dropdb ::
+\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.*") ) {
$has_etc{acl}++;
@@ -153,19 +164,28 @@ install ::
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
+\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"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
+\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"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
+\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");
}
}
+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;
+}
+
# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
{ my %word = (
a => -4,
@@ -208,4 +228,4 @@ sub requires_rt {
__END__
-#line 328
+#line 348
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
new file mode 100644
index 0000000..23ce911
--- /dev/null
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -0,0 +1,483 @@
+#line 1
+package Module::Install::RTx::Factory;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use strict;
+use File::Basename ();
+
+sub RTxInitDB {
+ my ($self, $action) = @_;
+
+ unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+
+ require RT;
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+
+ $RT::SbinPath ||= $RT::LocalPath;
+ $RT::SbinPath =~ s/local$/sbin/;
+
+ foreach my $file ($RT::CORE_CONFIG_FILE, $RT::SITE_CONFIG_FILE) {
+ next if !-e $file or -r $file;
+ die "No permission to read $file\n-- please re-run $0 with suitable privileges.\n";
+ }
+
+ RT::LoadConfig();
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ my @args = ("-Ilib");
+ push @args, "-I$RT::LocalPath/lib" if $RT::LocalPath;
+ push @args, (
+ "-I$lib_path",
+ "$RT::SbinPath/rt-setup-database",
+ "--action" => $action,
+ "--datadir" => "etc",
+ (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
+ "--dba" => $RT::DatabaseUser,
+ "--prompt-for-dba-password" => ''
+ );
+ print "$^X @args\n";
+ (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+sub RTxFactory {
+ my ($self, $RTx, $name, $drop) = @_;
+ my $namespace = "$RTx\::$name";
+
+ $self->RTxInit;
+
+ my $dbh = $RT::Handle->dbh;
+ # get all tables out of database
+ my @tables = $dbh->tables;
+ my ( %tablemap, %typemap, %modulemap );
+ my $driver = $RT::DatabaseType;
+
+ my $CollectionBaseclass = 'RT::SearchBuilder';
+ my $RecordBaseclass = 'RT::Record';
+ my $LicenseBlock = << '.';
+# BEGIN LICENSE BLOCK
+#
+# END LICENSE BLOCK
+.
+ my $Attribution = << '.';
+# Autogenerated by Module::Intall::RTx::Factory
+# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
+#
+# !! DO NOT EDIT THIS FILE !!
+#
+
+use strict;
+.
+ my $RecordInit = '';
+
+ @tables = map { do { {
+ my $table = $_;
+ $table =~ s/.*\.//g;
+ $table =~ s/\W//g;
+ $table =~ s/^\Q$name\E_//i or next;
+ $table ne 'sessions' or next;
+
+ $table = ucfirst(lc($table));
+ $table =~ s/$_/\u$_/ for qw(field group custom member value);
+ $table =~ s/(?<=Scrip)$_/\u$_/ for qw(action condition);
+ $table =~ s/$_/\U$_/ for qw(Acl);
+ $table = $name . '_' . $table;
+
+ $tablemap{$table} = $table;
+ $modulemap{$table} = $table;
+ if ( $table =~ /^(.*)s$/ ) {
+ $tablemap{$1} = $table;
+ $modulemap{$1} = $1;
+ }
+ $table;
+ } } } @tables;
+
+ $tablemap{'CreatedBy'} = 'User';
+ $tablemap{'UpdatedBy'} = 'User';
+
+ $typemap{'id'} = 'ro';
+ $typemap{'Creator'} = 'auto';
+ $typemap{'Created'} = 'auto';
+ $typemap{'Updated'} = 'auto';
+ $typemap{'UpdatedBy'} = 'auto';
+ $typemap{'LastUpdated'} = 'auto';
+ $typemap{'LastUpdatedBy'} = 'auto';
+
+ $typemap{lc($_)} = $typemap{$_} for keys %typemap;
+
+ foreach my $table (@tables) {
+ if ($drop) {
+ $dbh->do("DROP TABLE $table");
+ $dbh->do("DROP sequence ${table}_id_seq") if $driver eq 'Pg';
+ $dbh->do("DROP sequence ${table}_seq") if $driver eq 'Oracle';
+ next;
+ }
+
+ my $tablesingle = $table;
+ $tablesingle =~ s/^\Q$name\E_//i;
+ $tablesingle =~ s/s$//;
+ my $tableplural = $tablesingle . "s";
+
+ if ( $tablesingle eq 'ACL' ) {
+ $tablesingle = "ACE";
+ $tableplural = "ACL";
+ }
+
+ my %requirements;
+
+ my $CollectionClassName = $namespace . "::" . $tableplural;
+ my $RecordClassName = $namespace . "::" . $tablesingle;
+
+ my $path = $namespace;
+ $path =~ s/::/\//g;
+
+ my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
+ my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
+
+ #create a collection class
+ my $CreateInParams;
+ my $CreateOutParams;
+ my $ClassAccessible = "";
+ my $FieldsPod = "";
+ my $CreatePod = "";
+ my $CreateSub = "";
+ my %fields;
+ my $sth = $dbh->prepare("DESCRIBE $table");
+
+ if ( $driver eq 'Pg' ) {
+ $sth = $dbh->prepare(<<".");
+ SELECT a.attname, format_type(a.atttypid, a.atttypmod),
+ a.attnotnull, a.atthasdef, a.attnum
+ FROM pg_class c, pg_attribute a
+ WHERE c.relname ILIKE '$table'
+ AND a.attnum > 0
+ AND a.attrelid = c.oid
+ORDER BY a.attnum
+.
+ }
+ elsif ( $driver eq 'mysql' ) {
+ $sth = $dbh->prepare("DESCRIBE $table");
+ }
+ else {
+ die "$driver is currently unsupported";
+ }
+
+ $sth->execute;
+
+ while ( my $row = $sth->fetchrow_hashref() ) {
+ my ( $field, $type, $default );
+ if ( $driver eq 'Pg' ) {
+
+ $field = $row->{'attname'};
+ $type = $row->{'format_type'};
+ $default = $row->{'atthasdef'};
+
+ if ( $default != 0 ) {
+ my $tth = $dbh->prepare(<<".");
+SELECT substring(d.adsrc for 128)
+ FROM pg_attrdef d, pg_class c
+ WHERE c.relname = 'acct'
+ AND c.oid = d.adrelid
+ AND d.adnum = $row->{'attnum'}
+.
+ $tth->execute();
+ my @default = $tth->fetchrow_array;
+ $default = $default[0];
+ }
+
+ }
+ elsif ( $driver eq 'mysql' ) {
+ $field = $row->{'Field'};
+ $type = $row->{'Type'};
+ $default = $row->{'Default'};
+ }
+
+ $fields{$field} = 1;
+
+ #generate the 'accessible' datastructure
+
+ if ( $typemap{$field} eq 'auto' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1, auto => 1,";
+ }
+ elsif ( $typemap{$field} eq 'ro' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1,";
+ }
+ else {
+ $ClassAccessible .= " $field =>
+ {read => 1, write => 1,";
+
+ }
+
+ $ClassAccessible .= " type => '$type', default => '$default'},\n";
+
+ #generate pod for the accessible fields
+ $FieldsPod .= $self->_pod(<<".");
+^head2 $field
+
+Returns the current value of $field.
+(In the database, $field is stored as $type.)
+
+.
+
+ unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
+ $FieldsPod .= $self->_pod(<<".");
+
+^head2 Set$field VALUE
+
+
+Set $field to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, $field will be stored as a $type.)
+
+.
+ }
+
+ $FieldsPod .= $self->_pod(<<".");
+^cut
+
+.
+
+ if ( $modulemap{$field} ) {
+ $FieldsPod .= $self->_pod(<<".");
+^head2 ${field}Obj
+
+Returns the $modulemap{$field} Object which has the id returned by $field
+
+
+^cut
+
+sub ${field}Obj {
+ my \$self = shift;
+ my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
+ \$$field->Load(\$self->__Value('$field'));
+ return(\$$field);
+}
+.
+ $requirements{ $tablemap{$field} } =
+ "use ${namespace}::$modulemap{$field};";
+
+ }
+
+ unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
+
+ #generate create statement
+ $CreateInParams .= " $field => '$default',\n";
+ $CreateOutParams .=
+ " $field => \$args{'$field'},\n";
+
+ #gerenate pod for the create statement
+ $CreatePod .= " $type '$field'";
+ $CreatePod .= " defaults to '$default'" if ($default);
+ $CreatePod .= ".\n";
+
+ }
+
+ }
+
+ $CreateSub = <<".";
+sub Create {
+ my \$self = shift;
+ my \%args = (
+$CreateInParams
+ \@_);
+ \$self->SUPER::Create(
+$CreateOutParams);
+
+}
+.
+ $CreatePod .= "\n=cut\n\n";
+
+ my $CollectionClass = $LicenseBlock . $Attribution . $self->_pod(<<".") . $self->_magic_import($CollectionClassName);
+
+^head1 NAME
+
+$CollectionClassName -- Class Description
+
+^head1 SYNOPSIS
+
+use $CollectionClassName
+
+^head1 DESCRIPTION
+
+
+^head1 METHODS
+
+^cut
+
+package $CollectionClassName;
+
+use $CollectionBaseclass;
+use $RecordClassName;
+
+use vars qw( \@ISA );
+\@ISA= qw($CollectionBaseclass);
+
+
+sub _Init {
+ my \$self = shift;
+ \$self->{'table'} = '$table';
+ \$self->{'primary_key'} = 'id';
+
+.
+
+ if ( $fields{'SortOrder'} ) {
+
+ $CollectionClass .= $self->_pod(<<".");
+
+# By default, order by name
+\$self->OrderBy( ALIAS => 'main',
+ FIELD => 'SortOrder',
+ ORDER => 'ASC');
+.
+ }
+ $CollectionClass .= $self->_pod(<<".");
+ return ( \$self->SUPER::_Init(\@_) );
+}
+
+
+^head2 NewItem
+
+Returns an empty new $RecordClassName item
+
+^cut
+
+sub NewItem {
+ my \$self = shift;
+ return($RecordClassName->new(\$self->CurrentUser));
+}
+.
+
+ my $RecordClassHeader = $Attribution . "
+
+^head1 NAME
+
+$RecordClassName
+
+
+^head1 SYNOPSIS
+
+^head1 DESCRIPTION
+
+^head1 METHODS
+
+^cut
+
+package $RecordClassName;
+use $RecordBaseclass;
+";
+
+ foreach my $key ( keys %requirements ) {
+ $RecordClassHeader .= $requirements{$key} . "\n";
+ }
+ $RecordClassHeader .= <<".";
+
+use vars qw( \@ISA );
+\@ISA= qw( $RecordBaseclass );
+
+sub _Init {
+my \$self = shift;
+
+\$self->Table('$table');
+\$self->SUPER::_Init(\@_);
+}
+
+.
+
+ my $RecordClass = $LicenseBlock . $RecordClassHeader . $self->_pod(<<".") . $self->_magic_import($RecordClassName);
+
+$RecordInit
+
+^head2 Create PARAMHASH
+
+Create takes a hash of values and creates a row in the database:
+
+$CreatePod
+
+$CreateSub
+
+$FieldsPod
+
+sub _CoreAccessible {
+ {
+
+$ClassAccessible
+}
+};
+
+.
+
+ print "About to make $RecordClassPath, $CollectionClassPath\n";
+ `mkdir -p $path`;
+
+ open( RECORD, ">$RecordClassPath" );
+ print RECORD $RecordClass;
+ close(RECORD);
+
+ open( COL, ">$CollectionClassPath" );
+ print COL $CollectionClass;
+ close(COL);
+
+ }
+}
+
+sub _magic_import {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ #if (exists \$warnings::{unimport}) {
+ # no warnings qw(redefine);
+
+ my $path = $class;
+ $path =~ s#::#/#gi;
+
+
+ my $content = $self->_pod(<<".");
+ eval \"require ${class}_Overlay\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Overlay.pm}) {
+ die \$@;
+ };
+
+ eval \"require ${class}_Vendor\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Vendor.pm}) {
+ die \$@;
+ };
+
+ eval \"require ${class}_Local\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Local.pm}) {
+ die \$@;
+ };
+
+
+
+
+^head1 SEE ALSO
+
+This class allows \"overlay\" methods to be placed
+into the following files _Overlay is for a System overlay by the original author,
+_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
+
+These overlay files can contain new subs or subs to replace existing subs in this module.
+
+If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
+
+ no warnings qw(redefine);
+
+so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
+
+${class}_Overlay, ${class}_Vendor, ${class}_Local
+
+^cut
+
+
+1;
+.
+
+ return $content;
+}
+
+sub _pod {
+ my ($self, $text) = @_;
+ $text =~ s/^\^/=/mg;
+ return $text;
+}
diff --git a/lib/RT/Action/LinkWasReplyTo.pm b/lib/RT/Action/LinkWasReplyTo.pm
new file mode 100644
index 0000000..f6043cf
--- /dev/null
+++ b/lib/RT/Action/LinkWasReplyTo.pm
@@ -0,0 +1,37 @@
+package RT::Action::LinkWasReplyTo;
+use base 'RT::Action';
+use strict;
+
+sub Describe {
+ my $self = shift;
+ return ( ref $self );
+}
+
+sub Prepare {
+ return 1;
+}
+
+sub Commit {
+ my $self = shift;
+ my $Transaction = $self->TransactionObj;
+ my $FirstAttachment = $Transaction->Attachments->First;
+ return 1 unless $FirstAttachment;
+
+ my $OldTicket = $FirstAttachment->GetHeader('X-RT-Was-Reply-To');
+ return 1 unless $OldTicket;
+
+ my $Ticket = $self->TicketObj;
+
+ my ($val, $msg) = $Ticket->AddLink(Type => 'MemberOf',
+ Target => $OldTicket);
+
+ if ($val == 0) {
+ RT->Logger->error('Failed to link '.$Ticket->id.'to '.$OldTicket.": $msg\n");
+ }
+
+ return ($val);
+}
+
+RT::Base->_ImportOverlays();
+
+1;
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index ec9a358..bd32f3b 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -38,6 +38,7 @@ to see patches that improve it.
perl Makefile.PL
make
make install
+ make initdb
Register plugin in F<RT_SiteConfig.pm>:
commit 7d77afe49d301c21f91c77ecbecfb2d57203ea53
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Wed Oct 17 11:38:02 2012 +0100
Added documentation and link-type option
Pod docs in the Config module, and implemented link-type configuration
option, because I can't decide whether MemberOf or RefersTo is right, so
let the user have the choice...
diff --git a/etc/RepliesToResolved_Config.pm b/etc/RepliesToResolved_Config.pm
index c86abbd..cc8c158 100644
--- a/etc/RepliesToResolved_Config.pm
+++ b/etc/RepliesToResolved_Config.pm
@@ -1,8 +1,46 @@
package RT;
+=head1 RT::Extension::RepliesToResolved configuration
+
+Copy the default settings to your RT_SiteConfig.pm, and edit them
+there. Do not edit the settings in this file.
+
+=over 4
+
+=item C<%RepliesToResolved>
+
+C<%RepliesToResolved> contains default and optional per-queue
+parameters. The top level keys of the hash are either B<default>
+or the name of a queue. Within each of these items, there are the
+following configuration options:
+
+=over 4
+
+=item reopen-timelimit
+
+The time limit, in days, during which mail replies to tickets will
+cause the ticket to reopen. Setting this to 0 means that resolved
+tickets will never be reopened, but a new ticket will always be created
+instead. Setting this to undef restores the normal behaviour of RT,
+where replies will reopen the ticket.
+
+=item link-type
+
+This sets the type of link that the extension will make between the
+original ticket and the new ticket. The default is B<RefersTo>. See
+L<RT::Ticket> for details of available link types. Setting this to
+undef stops the link from being created.
+
+=back
+
+=back
+
+=cut
+
Set(%RepliesToResolved,
default => {
'reopen-timelimit' => 7,
+ 'link-type' => 'RefersTo',
},
);
diff --git a/lib/RT/Action/LinkWasReplyTo.pm b/lib/RT/Action/LinkWasReplyTo.pm
index f6043cf..1e0c2c6 100644
--- a/lib/RT/Action/LinkWasReplyTo.pm
+++ b/lib/RT/Action/LinkWasReplyTo.pm
@@ -13,6 +13,21 @@ sub Prepare {
sub Commit {
my $self = shift;
+
+ my $r2r_config = RT->Config->Get('RepliesToResolved');
+
+ my $Ticket = $self->TicketObj;
+ my $queue = $Ticket->QueueObj->Name;
+
+ my $linktype = $r2r_config->{'default'}->{'link-type'};
+ if (exists($r2r_config->{$queue})) {
+ if (exists($r2r_config->{$queue}->{'link-type'})) {
+ $linktype = $r2r_config->{$queue}->{'link-type'};
+ }
+ }
+
+ return 1 unless (defined($linktype));
+
my $Transaction = $self->TransactionObj;
my $FirstAttachment = $Transaction->Attachments->First;
return 1 unless $FirstAttachment;
@@ -20,10 +35,11 @@ sub Commit {
my $OldTicket = $FirstAttachment->GetHeader('X-RT-Was-Reply-To');
return 1 unless $OldTicket;
- my $Ticket = $self->TicketObj;
+ my ($val, $msg);
+ my $map = $Ticket->LINKTYPEMAP;
- my ($val, $msg) = $Ticket->AddLink(Type => 'MemberOf',
- Target => $OldTicket);
+ ($val, $msg) = $Ticket->AddLink(Type => $map->{$linktype}->{'Type'},
+ $map->{$linktype}->{'Mode'} => $OldTicket);
if ($val == 0) {
RT->Logger->error('Failed to link '.$Ticket->id.'to '.$OldTicket.": $msg\n");
commit 8bb4e8779f984983c6707a91de87594cee10fc42
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Thu Oct 18 13:31:05 2012 +0100
Updated MANIFEST with new files
diff --git a/MANIFEST b/MANIFEST
index 2bb909a..af40a7f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,5 @@
+etc/initialdata
+etc/RepliesToResolved_Config.pm
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
@@ -6,8 +8,10 @@ inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/RTx.pm
+inc/Module/Install/RTx/Factory.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
+lib/RT/Action/LinkWasReplyTo.pm
lib/RT/Extension/RepliesToResolved.pm
Makefile.PL
MANIFEST This list of files
commit d7157d857ef2d6b694800751682061eb0814d654
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Fri Oct 19 22:19:07 2012 +0100
Adjust code to match Ruslan's style preferences
Ruslan made some comments regarding some coding style issues,
and regarding when the new and old subjects for the message should be
used. These comments are addressed by this commit.
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index bd32f3b..7427414 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -51,17 +51,18 @@ Register plugin in F<RT_SiteConfig.pm>:
=cut
sub RemoveSubjectTags {
- my $subject = shift;
+ my $entity = shift;
+ my $subject = $entity->head->get('Subject');
my $rtname = RT->Config->Get('rtname');
my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
-
+
if ( $subject !~ s/\[$test_name\s+\#\d+\s*\]//i ) {
foreach my $tag ( RT->System->SubjectTag ) {
next unless $subject =~ s/\[\Q$tag\E\s+\#\d+\s*\]//i;
last;
}
}
- return $subject;
+ $entity->head->replace(Subject => $subject);
}
require RT::Interface::Email;
@@ -84,27 +85,25 @@ package RT::Interface::Email;
$ticket->Load($id);
return $id unless $ticket->id;
- if ( $ticket->Status eq 'resolved' ) {
- my $r2r_config = RT->Config->Get('RepliesToResolved');
- my $reopen_timelimit = $r2r_config->{'default'}->{'reopen-timelimit'} || 0;
- if (exists($r2r_config->{$ticket->QueueObj->Name})) {
- $reopen_timelimit = $r2r_config->{$ticket->QueueObj->Name}->{'reopen-timelimit'};
- }
-
- # If the timelimit is undef, follow normal RT behaviour
- return $id unless defined($reopen_timelimit);
-
- if ($ticket->ResolvedObj->Diff()/-86400 > $reopen_timelimit) {
-
- $RT::Logger->info("A reply to resolved ticket #". $ticket->id .", creating a new ticket");
-
- $entity->head->set("X-RT-Was-Reply-To" => Encode::encode_utf8($ticket->id));
- my $subject = $entity->head->get('Subject') || '';
- $entity->head->set('Subject' => RT::Extension::RepliesToResolved::RemoveSubjectTags($subject));
- return undef;
- }
+ return $id unless ( $ticket->Status eq 'resolved' );
+
+ my $r2r_config = RT->Config->Get('RepliesToResolved');
+ my $reopen_timelimit = $r2r_config->{'default'}->{'reopen-timelimit'} || 0;
+ if (exists($r2r_config->{$ticket->QueueObj->Name})) {
+ $reopen_timelimit = $r2r_config->{$ticket->QueueObj->Name}->{'reopen-timelimit'};
}
- return $id;
+
+ # If the timelimit is undef, follow normal RT behaviour
+ return $id unless defined($reopen_timelimit);
+
+ return $id if ($ticket->ResolvedObj->Diff()/-86400 < $reopen_timelimit);
+
+ $RT::Logger->info("A reply to resolved ticket #". $ticket->id .", creating a new ticket");
+
+ $entity->head->replace("X-RT-Was-Reply-To" => Encode::encode_utf8($ticket->id));
+ &RT::Extension::RepliesToResolved::RemoveSubjectTags($entity);
+
+ return undef;
};
}
commit 1287066a5c2075499bf22c49109675e0b9eb88ed
Author: Tim Cutts <tjrc at sanger.ac.uk>
Date: Sat Oct 20 22:13:29 2012 +0100
Add option to configure which statuses we handle
It used to be hardcoded as 'resolved'; this allows the admin to
choose which statuses are treated as closed, and responded to by this
extension.
diff --git a/etc/RepliesToResolved_Config.pm b/etc/RepliesToResolved_Config.pm
index cc8c158..ee7dee1 100644
--- a/etc/RepliesToResolved_Config.pm
+++ b/etc/RepliesToResolved_Config.pm
@@ -16,6 +16,11 @@ following configuration options:
=over 4
+=item closed-status-list
+
+The list of statuses which the extension will respond to; the default
+is just the 'resolved' status.
+
=item reopen-timelimit
The time limit, in days, during which mail replies to tickets will
@@ -39,9 +44,10 @@ undef stops the link from being created.
Set(%RepliesToResolved,
default => {
+ 'closed-status-list' => [ qw(resolved) ],
'reopen-timelimit' => 7,
'link-type' => 'RefersTo',
},
);
-
+1;
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index 7427414..8c0c839 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -85,14 +85,19 @@ package RT::Interface::Email;
$ticket->Load($id);
return $id unless $ticket->id;
- return $id unless ( $ticket->Status eq 'resolved' );
-
my $r2r_config = RT->Config->Get('RepliesToResolved');
- my $reopen_timelimit = $r2r_config->{'default'}->{'reopen-timelimit'} || 0;
+ my $config = $r2r_config->{'default'};
if (exists($r2r_config->{$ticket->QueueObj->Name})) {
- $reopen_timelimit = $r2r_config->{$ticket->QueueObj->Name}->{'reopen-timelimit'};
+ $config = $r2r_config->{$ticket->QueueObj->Name};
}
+ my %closed_statuses;
+ @closed_statuses{@{$config->{'closed-status-list'}}} = ();
+
+ return $id unless (exists($closed_statuses{$ticket->Status}));
+
+ my $reopen_timelimit = $config->{'reopen-timelimit'};
+
# If the timelimit is undef, follow normal RT behaviour
return $id unless defined($reopen_timelimit);
commit 4f654c3c73a8a53116a10bccd3a8ab0fdfcd4161
Merge: 28ab105 1287066
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 8 19:09:41 2012 -0500
Merge branch 'timelimit-option'
commit 191479d2bccbd9bb7e6e8d3ebf2851d8ffdb4aed
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 8 19:55:35 2012 -0500
Update README with our more standard language
diff --git a/README b/README
index 2ecb6da..742c67a 100644
--- a/README
+++ b/README
@@ -15,25 +15,45 @@ RT 4.0.7 required or you have to patch RT
<https://github.com/bestpractical/rt/commit/139f5da162ceb64bf33a31d7013e
8b98d6866d18.patch>
-BETA
- It's very simple module to give an example on how to do it. I hope to
- see patches that improve it.
-
INSTALLATION
- perl Makefile.PL
- make
- make install
- make initdb
+ perl Makefile.PL
+ make
+ make install
+ May need root permissions
+
+ make initdb
+ Only run this the first time you install this module.
+
+ If you run this twice, you may end up with duplicate data in your
+ database.
+
+ If you are upgrading this module, check for upgrading instructions
+ in case changes need to be made to your database.
+
+ Edit your /opt/rt4/etc/RT_SiteConfig.pm
+ Add this line:
+
+ Set(@Plugins, qw(RT::Extension::RepliesToResolved));
+
+ or add "RT::Extension::RepliesToResolved" to your existing @Plugins
+ line.
+
+ Clear your mason cache
+ rm -rf /opt/rt4/var/mason_data/obj
- Register plugin in RT_SiteConfig.pm:
+ Restart your webserver
- Set(@Plugins, qw(
- RT::Extension::RepliesToResolved
- ... other plugins ...
- ));
+AUTHORS
+ Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
+ Tim Cutts E<lt>tjrc at sanger.ac.ukE<gt>
-AUTHOR
- Ruslan Zakirov <ruz at bestpractical.com> Tim Cutts <tjrc at sanger.ac.uk>
+BUGS
+ All bugs should be reported via email to
+ bug-RT-Extension-RepliesToResolved at rt.cpan.org
+ <mailto:bug-RT-Extension-RepliesToResolved at rt.cpan.org> or via the web
+ at rt.cpan.org
+ <http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-RepliesTo
+ Resolved>.
LICENSE
Under the same terms as perl itself.
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index 8c0c839..f8bc858 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -28,25 +28,43 @@ You can fetch patch from github:
L<https://github.com/bestpractical/rt/commit/139f5da162ceb64bf33a31d7013e8b98d6866d18.patch>
-=head1 BETA
+=head1 INSTALLATION
-It's very simple module to give an example on how to do it. I hope
-to see patches that improve it.
+=over
-=head1 INSTALLATION
+=item perl Makefile.PL
+
+=item make
+
+=item make install
+
+May need root permissions
+
+=item make initdb
+
+Only run this the first time you install this module.
+
+If you run this twice, you may end up with duplicate data
+in your database.
- perl Makefile.PL
- make
- make install
- make initdb
+If you are upgrading this module, check for upgrading instructions
+in case changes need to be made to your database.
-Register plugin in F<RT_SiteConfig.pm>:
+=item Edit your /opt/rt4/etc/RT_SiteConfig.pm
- Set(@Plugins, qw(
- RT::Extension::RepliesToResolved
- ... other plugins ...
- ));
+Add this line:
+ Set(@Plugins, qw(RT::Extension::RepliesToResolved));
+
+or add C<RT::Extension::RepliesToResolved> to your existing C<@Plugins> line.
+
+=item Clear your mason cache
+
+ rm -rf /opt/rt4/var/mason_data/obj
+
+=item Restart your webserver
+
+=back
=cut
@@ -112,10 +130,17 @@ package RT::Interface::Email;
};
}
-=head1 AUTHOR
+=head1 AUTHORS
+
+ Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
+ Tim Cutts E<lt>tjrc at sanger.ac.ukE<gt>
+
+=head1 BUGS
-Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
-Tim Cutts E<lt>tjrc at sanger.ac.ukE<gt>
+All bugs should be reported via email to
+L<bug-RT-Extension-RepliesToResolved at rt.cpan.org|mailto:bug-RT-Extension-RepliesToResolved at rt.cpan.org>
+or via the web at
+L<rt.cpan.org|http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-RepliesToResolved>.
=head1 LICENSE
commit 1c3d1545eb5c9acf7fffc21d6915a376838ea1ee
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 8 20:02:03 2012 -0500
updgrade Module::Install::RTx
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 73b9cda..ce01018 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.29';
+our $VERSION = '0.30';
use FindBin;
use File::Glob ();
@@ -129,18 +129,7 @@ install ::
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"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\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.*") ) {
$has_etc{acl}++;
@@ -164,28 +153,19 @@ dropdb ::
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -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 \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -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 \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -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 \$(NAME) \$(VERSION)))"
.
$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;
-}
-
# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
{ my %word = (
a => -4,
@@ -228,4 +208,4 @@ sub requires_rt {
__END__
-#line 348
+#line 328
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
index 23ce911..a8702e4 100644
--- a/inc/Module/Install/RTx/Factory.pm
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -6,7 +6,7 @@ use strict;
use File::Basename ();
sub RTxInitDB {
- my ($self, $action) = @_;
+ my ($self, $action, $name, $version) = @_;
unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
@@ -23,6 +23,8 @@ sub RTxInitDB {
RT::LoadConfig();
+ require RT::System;
+
my $lib_path = File::Basename::dirname($INC{'RT.pm'});
my @args = ("-Ilib");
push @args, "-I$RT::LocalPath/lib" if $RT::LocalPath;
@@ -33,451 +35,12 @@ sub RTxInitDB {
"--datadir" => "etc",
(($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
"--dba" => $RT::DatabaseUser,
- "--prompt-for-dba-password" => ''
+ "--prompt-for-dba-password" => '',
+ (RT::System->can('AddUpgradeHistory') ? ("--package" => $name, "--ext-version" => $version) : ()),
);
+
print "$^X @args\n";
(system($^X, @args) == 0) or die "...returned with error: $?\n";
}
-sub RTxFactory {
- my ($self, $RTx, $name, $drop) = @_;
- my $namespace = "$RTx\::$name";
-
- $self->RTxInit;
-
- my $dbh = $RT::Handle->dbh;
- # get all tables out of database
- my @tables = $dbh->tables;
- my ( %tablemap, %typemap, %modulemap );
- my $driver = $RT::DatabaseType;
-
- my $CollectionBaseclass = 'RT::SearchBuilder';
- my $RecordBaseclass = 'RT::Record';
- my $LicenseBlock = << '.';
-# BEGIN LICENSE BLOCK
-#
-# END LICENSE BLOCK
-.
- my $Attribution = << '.';
-# Autogenerated by Module::Intall::RTx::Factory
-# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
-#
-# !! DO NOT EDIT THIS FILE !!
-#
-
-use strict;
-.
- my $RecordInit = '';
-
- @tables = map { do { {
- my $table = $_;
- $table =~ s/.*\.//g;
- $table =~ s/\W//g;
- $table =~ s/^\Q$name\E_//i or next;
- $table ne 'sessions' or next;
-
- $table = ucfirst(lc($table));
- $table =~ s/$_/\u$_/ for qw(field group custom member value);
- $table =~ s/(?<=Scrip)$_/\u$_/ for qw(action condition);
- $table =~ s/$_/\U$_/ for qw(Acl);
- $table = $name . '_' . $table;
-
- $tablemap{$table} = $table;
- $modulemap{$table} = $table;
- if ( $table =~ /^(.*)s$/ ) {
- $tablemap{$1} = $table;
- $modulemap{$1} = $1;
- }
- $table;
- } } } @tables;
-
- $tablemap{'CreatedBy'} = 'User';
- $tablemap{'UpdatedBy'} = 'User';
-
- $typemap{'id'} = 'ro';
- $typemap{'Creator'} = 'auto';
- $typemap{'Created'} = 'auto';
- $typemap{'Updated'} = 'auto';
- $typemap{'UpdatedBy'} = 'auto';
- $typemap{'LastUpdated'} = 'auto';
- $typemap{'LastUpdatedBy'} = 'auto';
-
- $typemap{lc($_)} = $typemap{$_} for keys %typemap;
-
- foreach my $table (@tables) {
- if ($drop) {
- $dbh->do("DROP TABLE $table");
- $dbh->do("DROP sequence ${table}_id_seq") if $driver eq 'Pg';
- $dbh->do("DROP sequence ${table}_seq") if $driver eq 'Oracle';
- next;
- }
-
- my $tablesingle = $table;
- $tablesingle =~ s/^\Q$name\E_//i;
- $tablesingle =~ s/s$//;
- my $tableplural = $tablesingle . "s";
-
- if ( $tablesingle eq 'ACL' ) {
- $tablesingle = "ACE";
- $tableplural = "ACL";
- }
-
- my %requirements;
-
- my $CollectionClassName = $namespace . "::" . $tableplural;
- my $RecordClassName = $namespace . "::" . $tablesingle;
-
- my $path = $namespace;
- $path =~ s/::/\//g;
-
- my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
- my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
-
- #create a collection class
- my $CreateInParams;
- my $CreateOutParams;
- my $ClassAccessible = "";
- my $FieldsPod = "";
- my $CreatePod = "";
- my $CreateSub = "";
- my %fields;
- my $sth = $dbh->prepare("DESCRIBE $table");
-
- if ( $driver eq 'Pg' ) {
- $sth = $dbh->prepare(<<".");
- SELECT a.attname, format_type(a.atttypid, a.atttypmod),
- a.attnotnull, a.atthasdef, a.attnum
- FROM pg_class c, pg_attribute a
- WHERE c.relname ILIKE '$table'
- AND a.attnum > 0
- AND a.attrelid = c.oid
-ORDER BY a.attnum
-.
- }
- elsif ( $driver eq 'mysql' ) {
- $sth = $dbh->prepare("DESCRIBE $table");
- }
- else {
- die "$driver is currently unsupported";
- }
-
- $sth->execute;
-
- while ( my $row = $sth->fetchrow_hashref() ) {
- my ( $field, $type, $default );
- if ( $driver eq 'Pg' ) {
-
- $field = $row->{'attname'};
- $type = $row->{'format_type'};
- $default = $row->{'atthasdef'};
-
- if ( $default != 0 ) {
- my $tth = $dbh->prepare(<<".");
-SELECT substring(d.adsrc for 128)
- FROM pg_attrdef d, pg_class c
- WHERE c.relname = 'acct'
- AND c.oid = d.adrelid
- AND d.adnum = $row->{'attnum'}
-.
- $tth->execute();
- my @default = $tth->fetchrow_array;
- $default = $default[0];
- }
-
- }
- elsif ( $driver eq 'mysql' ) {
- $field = $row->{'Field'};
- $type = $row->{'Type'};
- $default = $row->{'Default'};
- }
-
- $fields{$field} = 1;
-
- #generate the 'accessible' datastructure
-
- if ( $typemap{$field} eq 'auto' ) {
- $ClassAccessible .= " $field =>
- {read => 1, auto => 1,";
- }
- elsif ( $typemap{$field} eq 'ro' ) {
- $ClassAccessible .= " $field =>
- {read => 1,";
- }
- else {
- $ClassAccessible .= " $field =>
- {read => 1, write => 1,";
-
- }
-
- $ClassAccessible .= " type => '$type', default => '$default'},\n";
-
- #generate pod for the accessible fields
- $FieldsPod .= $self->_pod(<<".");
-^head2 $field
-
-Returns the current value of $field.
-(In the database, $field is stored as $type.)
-
-.
-
- unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
- $FieldsPod .= $self->_pod(<<".");
-
-^head2 Set$field VALUE
-
-
-Set $field to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, $field will be stored as a $type.)
-
-.
- }
-
- $FieldsPod .= $self->_pod(<<".");
-^cut
-
-.
-
- if ( $modulemap{$field} ) {
- $FieldsPod .= $self->_pod(<<".");
-^head2 ${field}Obj
-
-Returns the $modulemap{$field} Object which has the id returned by $field
-
-
-^cut
-
-sub ${field}Obj {
- my \$self = shift;
- my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
- \$$field->Load(\$self->__Value('$field'));
- return(\$$field);
-}
-.
- $requirements{ $tablemap{$field} } =
- "use ${namespace}::$modulemap{$field};";
-
- }
-
- unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
-
- #generate create statement
- $CreateInParams .= " $field => '$default',\n";
- $CreateOutParams .=
- " $field => \$args{'$field'},\n";
-
- #gerenate pod for the create statement
- $CreatePod .= " $type '$field'";
- $CreatePod .= " defaults to '$default'" if ($default);
- $CreatePod .= ".\n";
-
- }
-
- }
-
- $CreateSub = <<".";
-sub Create {
- my \$self = shift;
- my \%args = (
-$CreateInParams
- \@_);
- \$self->SUPER::Create(
-$CreateOutParams);
-
-}
-.
- $CreatePod .= "\n=cut\n\n";
-
- my $CollectionClass = $LicenseBlock . $Attribution . $self->_pod(<<".") . $self->_magic_import($CollectionClassName);
-
-^head1 NAME
-
-$CollectionClassName -- Class Description
-
-^head1 SYNOPSIS
-
-use $CollectionClassName
-
-^head1 DESCRIPTION
-
-
-^head1 METHODS
-
-^cut
-
-package $CollectionClassName;
-
-use $CollectionBaseclass;
-use $RecordClassName;
-
-use vars qw( \@ISA );
-\@ISA= qw($CollectionBaseclass);
-
-
-sub _Init {
- my \$self = shift;
- \$self->{'table'} = '$table';
- \$self->{'primary_key'} = 'id';
-
-.
-
- if ( $fields{'SortOrder'} ) {
-
- $CollectionClass .= $self->_pod(<<".");
-
-# By default, order by name
-\$self->OrderBy( ALIAS => 'main',
- FIELD => 'SortOrder',
- ORDER => 'ASC');
-.
- }
- $CollectionClass .= $self->_pod(<<".");
- return ( \$self->SUPER::_Init(\@_) );
-}
-
-
-^head2 NewItem
-
-Returns an empty new $RecordClassName item
-
-^cut
-
-sub NewItem {
- my \$self = shift;
- return($RecordClassName->new(\$self->CurrentUser));
-}
-.
-
- my $RecordClassHeader = $Attribution . "
-
-^head1 NAME
-
-$RecordClassName
-
-
-^head1 SYNOPSIS
-
-^head1 DESCRIPTION
-
-^head1 METHODS
-
-^cut
-
-package $RecordClassName;
-use $RecordBaseclass;
-";
-
- foreach my $key ( keys %requirements ) {
- $RecordClassHeader .= $requirements{$key} . "\n";
- }
- $RecordClassHeader .= <<".";
-
-use vars qw( \@ISA );
-\@ISA= qw( $RecordBaseclass );
-
-sub _Init {
-my \$self = shift;
-
-\$self->Table('$table');
-\$self->SUPER::_Init(\@_);
-}
-
-.
-
- my $RecordClass = $LicenseBlock . $RecordClassHeader . $self->_pod(<<".") . $self->_magic_import($RecordClassName);
-
-$RecordInit
-
-^head2 Create PARAMHASH
-
-Create takes a hash of values and creates a row in the database:
-
-$CreatePod
-
-$CreateSub
-
-$FieldsPod
-
-sub _CoreAccessible {
- {
-
-$ClassAccessible
-}
-};
-
-.
-
- print "About to make $RecordClassPath, $CollectionClassPath\n";
- `mkdir -p $path`;
-
- open( RECORD, ">$RecordClassPath" );
- print RECORD $RecordClass;
- close(RECORD);
-
- open( COL, ">$CollectionClassPath" );
- print COL $CollectionClass;
- close(COL);
-
- }
-}
-
-sub _magic_import {
- my $self = shift;
- my $class = ref($self) || $self;
-
- #if (exists \$warnings::{unimport}) {
- # no warnings qw(redefine);
-
- my $path = $class;
- $path =~ s#::#/#gi;
-
-
- my $content = $self->_pod(<<".");
- eval \"require ${class}_Overlay\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Overlay.pm}) {
- die \$@;
- };
-
- eval \"require ${class}_Vendor\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Vendor.pm}) {
- die \$@;
- };
-
- eval \"require ${class}_Local\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Local.pm}) {
- die \$@;
- };
-
-
-
-
-^head1 SEE ALSO
-
-This class allows \"overlay\" methods to be placed
-into the following files _Overlay is for a System overlay by the original author,
-_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
-
-These overlay files can contain new subs or subs to replace existing subs in this module.
-
-If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
-
- no warnings qw(redefine);
-
-so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
-
-${class}_Overlay, ${class}_Vendor, ${class}_Local
-
-^cut
-
-
1;
-.
-
- return $content;
-}
-
-sub _pod {
- my ($self, $text) = @_;
- $text =~ s/^\^/=/mg;
- return $text;
-}
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index fb7075f..6a80818 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,7 +7,7 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.18';
+$VERSION = '0.20';
sub readme_from {
my $self = shift;
commit b818243db4f671e6c2973566049aac902d1441f7
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Thu Nov 8 20:05:57 2012 -0500
Point out the default configuration options and how to change them.
diff --git a/README b/README
index 742c67a..2aa280e 100644
--- a/README
+++ b/README
@@ -43,6 +43,19 @@ INSTALLATION
Restart your webserver
+CONFIGURATION
+ Configuration for this extension is defined in
+
+ /opt/rt4/local/plugins/RT-Extension-RepliesToResolved/etc/RepliesToResolved_Config.pm
+
+ You can read about the options in that file and then set your own
+ options in your RT_SiteConfig.pm file.
+
+ By default, after 7 days, this module will intercept mail to resolved
+ tickets and force the creation of a new ticket. It then creates a
+ RefersTo link between the two tickets. Each of these (time, statuses,
+ link) is configurable.
+
AUTHORS
Ruslan Zakirov E<lt>ruz at bestpractical.comE<gt>
Tim Cutts E<lt>tjrc at sanger.ac.ukE<gt>
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index f8bc858..59bee12 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -66,6 +66,20 @@ or add C<RT::Extension::RepliesToResolved> to your existing C<@Plugins> line.
=back
+=head1 CONFIGURATION
+
+Configuration for this extension is defined in
+
+ /opt/rt4/local/plugins/RT-Extension-RepliesToResolved/etc/RepliesToResolved_Config.pm
+
+You can read about the options in that file and then set your own
+options in your RT_SiteConfig.pm file.
+
+By default, after 7 days, this module will intercept mail to resolved
+tickets and force the creation of a new ticket. It then creates a
+RefersTo link between the two tickets. Each of these (time, statuses,
+link) is configurable.
+
=cut
sub RemoveSubjectTags {
commit ebfbe330a716bd67890024ff1943e57c82ba8b6f
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Nov 9 17:49:14 2012 -0500
Add some warnings about the kind of string you have.
If you try to concat a string with the UTF8 flag or other shenanigans in
here, shenanigans would occur.
diff --git a/lib/RT/Extension/RepliesToResolved.pm b/lib/RT/Extension/RepliesToResolved.pm
index 59bee12..9354e94 100644
--- a/lib/RT/Extension/RepliesToResolved.pm
+++ b/lib/RT/Extension/RepliesToResolved.pm
@@ -84,6 +84,9 @@ link) is configurable.
sub RemoveSubjectTags {
my $entity = shift;
+ # Keep in mind that this string has gone through RT's MIME header
+ # decoding already and then was encoded as UTF-8. You're getting a
+ # string of UTF-8 octets without Perl's UTF8 flag. Be careful.
my $subject = $entity->head->get('Subject');
my $rtname = RT->Config->Get('rtname');
my $test_name = RT->Config->Get('EmailSubjectTagRegex') || qr/\Q$rtname\E/i;
commit 71335ccb35565f107cb4508c290ce374bda41efe
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Fri Nov 9 18:02:54 2012 -0500
You shouldn't need a package declaration in the config.
diff --git a/etc/RepliesToResolved_Config.pm b/etc/RepliesToResolved_Config.pm
index ee7dee1..34290e0 100644
--- a/etc/RepliesToResolved_Config.pm
+++ b/etc/RepliesToResolved_Config.pm
@@ -1,5 +1,3 @@
-package RT;
-
=head1 RT::Extension::RepliesToResolved configuration
Copy the default settings to your RT_SiteConfig.pm, and edit them
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list