[Bps-public-commit] rt-extension-setdefaultowner branch, master, created. 45d4a832510b69979ce98a1123b7d06dcbffcb70
? sunnavy
sunnavy at bestpractical.com
Fri Jan 21 21:39:26 EST 2011
The branch, master has been created
at 45d4a832510b69979ce98a1123b7d06dcbffcb70 (commit)
- Log -----------------------------------------------------------------
commit 45d4a832510b69979ce98a1123b7d06dcbffcb70
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jan 22 10:38:22 2011 +0800
initial import
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..bfaf713
--- /dev/null
+++ b/Changes
@@ -0,0 +1,2 @@
+0.01 Thu Jan 20 13:11:40 CST 2011
+ initial release
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..f0efbbe
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,22 @@
+---
+abstract: 'set default owner of tickets'
+author:
+ - 'sunnavy C<< <sunnavy at bestpractical.com> >>'
+build_requires:
+ ExtUtils::MakeMaker: 6.42
+configure_requires:
+ ExtUtils::MakeMaker: 6.42
+distribution_type: module
+generated_by: 'Module::Install version 1.00'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: RT-Extension-SetDefaultOwner
+no_index:
+ directory:
+ - etc
+ - inc
+resources:
+ license: http://dev.perl.org/licenses/
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..41b2441
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,4 @@
+use inc::Module::Install;
+RTx('RT-Extension-SetDefaultOwner');
+all_from('lib/RT/Extension/SetDefaultOwner.pm');
+&WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..c1dd8ee
--- /dev/null
+++ b/README
@@ -0,0 +1,30 @@
+NAME
+ RT::Extension::SetDefaultOwner - set default owner of tickets
+
+DESCRIPTION
+ RT's default owner is nobody, this extension can customize this so you
+ can set another user as the default owner.
+
+INSTALLATION
+
+ perl Makefile.PL
+ make
+ make install
+ make initdb # first time only
+
+ if with RT 3.8+, you will need to add extension to the Plugins:
+ Set( @Plugins, qw(... RT::Extension::SetDefaultOwner) );
+
+ to Set default owner to user named "foo"
+ Set($DefaultOwner, 'foo');
+
+AUTHOR
+ sunnavy "<sunnavy at bestpractical.com>"
+
+LICENCE AND COPYRIGHT
+ RT-Extension-SetDefaultOwner is Copyright 2011 Best Practical Solutions,
+ LLC.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
diff --git a/etc/initialdata b/etc/initialdata
new file mode 100644
index 0000000..34554d7
--- /dev/null
+++ b/etc/initialdata
@@ -0,0 +1,22 @@
+# -*- perl -*-
+
+ at Scrips = (
+ {
+ Description => 'Set Default Owner', # loc
+ ScripCondition => 'On Create', # loc
+ ScripAction => 'Set Default Owner', # loc
+ Template => 'Blank',
+ },
+
+);
+
+ at ScripActions = (
+ {
+ Name => 'Set Default Owner', # loc
+ Description => 'Set Default Owner', # loc
+ ExecModule => 'SetDefaultOwner',
+ }
+
+);
+
+1;
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..8ee839d
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,470 @@
+#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.005;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+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 = '1.00';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # 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
+
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # 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 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+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));
+
+ #-------------------------------------------------------------
+
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
+
+ local $^W;
+ 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"};
+ }
+
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+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;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{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 ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
+ # 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 {
+ 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) = @_;
+
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ $should_reload = 1;
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $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) ) {
+ 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;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+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]): $!";
+}
+END_NEW
+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]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $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;
+}
+
+sub _cmp ($$) {
+ _version($_[0]) <=> _version($_[1]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..b55bda3
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.00';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
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/SetDefaultOwner.pm b/lib/RT/Action/SetDefaultOwner.pm
new file mode 100644
index 0000000..fbe92a1
--- /dev/null
+++ b/lib/RT/Action/SetDefaultOwner.pm
@@ -0,0 +1,41 @@
+package RT::Action::SetDefaultOwner;
+
+use strict;
+use warnings;
+
+use base qw(RT::Action);
+
+sub Describe {
+ my $self = shift;
+ return ( ref $self );
+}
+
+sub Prepare {
+ return (1);
+}
+
+sub Commit {
+ my $self = shift;
+
+ my $ticket = $self->TicketObj;
+ if ( $ticket->Owner == $RT::Nobody->id ) {
+ my $owner = RT->Config->Get('DefaultOwner');
+ if ($owner) {
+ my ( $ret, $msg ) = $ticket->SetOwner($owner);
+ if ( $ret ) {
+ return 1;
+ }
+ else {
+ $RT::Logger->error( "Failed to set owner of ticket"
+ . $ticket->id
+ . " to $owner: $msg" );
+ }
+ }
+ else {
+ $RT::Logger->warn("No DefaultOwner set in config");
+ }
+ }
+ return;
+}
+
+1;
diff --git a/lib/RT/Extension/SetDefaultOwner.pm b/lib/RT/Extension/SetDefaultOwner.pm
new file mode 100644
index 0000000..6faedac
--- /dev/null
+++ b/lib/RT/Extension/SetDefaultOwner.pm
@@ -0,0 +1,33 @@
+use warnings;
+use strict;
+
+package RT::Extension::SetDefaultOwner;
+
+=head1 NAME
+
+RT::Extension::SetDefaultOwner - set default owner of tickets
+
+=cut
+
+our $VERSION = '0.01';
+
+1;
+
+=head1 DESCRIPTION
+
+RT's default owner is nobody, this extension can customize this so you can
+set another user as the default owner.
+
+=head1 AUTHOR
+
+sunnavy C<< <sunnavy at bestpractical.com> >>
+
+=head1 LICENCE AND COPYRIGHT
+
+RT-Extension-SetDefaultOwner is Copyright 2011 Best Practical Solutions, LLC.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list