[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