[Rt-commit] r2256 - in Module-Install-RTx: . lib lib/Module
lib/Module/Install lib/Module/Install/RTx t
jesse at bestpractical.com
jesse at bestpractical.com
Thu Feb 24 16:29:48 EST 2005
Author: jesse
Date: Thu Feb 24 16:29:47 2005
New Revision: 2256
Added:
Module-Install-RTx/Changes
Module-Install-RTx/MANIFEST
Module-Install-RTx/Makefile.PL
Module-Install-RTx/README
Module-Install-RTx/lib/
Module-Install-RTx/lib/Module/
Module-Install-RTx/lib/Module/Install/
Module-Install-RTx/lib/Module/Install/RTx/
Module-Install-RTx/lib/Module/Install/RTx.pm
Module-Install-RTx/lib/Module/Install/RTx/Factory.pm
Module-Install-RTx/t/
Module-Install-RTx/t/0-signature.t
Module-Install-RTx/t/1-basic.t
Modified:
Module-Install-RTx/ (props changed)
Log:
r5937 at hualien (orig r794): svm | 2004-11-28 13:51:07 -0500
SVM: skipping changes 0-794 for http://svn.elixus.org/member/autrijus
Added: Module-Install-RTx/Changes
==============================================================================
--- (empty file)
+++ Module-Install-RTx/Changes Thu Feb 24 16:29:47 2005
@@ -0,0 +1,64 @@
+[Changes for 0.10 - 2004-09-09]
+
+* "make initialize-database" added as an alias to "make initdb",
+ for better consistency with core RT installation.
+
+ Reported by: Sika.
+
+[Changes for 0.09 - 2004-09-09]
+
+* Moved under SVK management; remove all keyword expansion lines.
+
+* Corrected the use of $ENV{RTHOME} and documented it.
+
+[Changes for 0.08 - 2004-05-31]
+
+* "make initdb" now moved to M::I::RTx::Factory, so the person
+ running "perl Makefile.PL" needs not have permission to read
+ RT_SiteConfig.pm.
+
+* M::I::RTx::Factory now survives pod-stripping.
+
+* Jesse reports that RTx('RT-Foo-Bar') breaks.
+
+* Improve table detection in Pg.
+
+* Better handling failed require() on _Overlay classes in the factory.
+
+[Changes for 0.07 - 2004-05-13]
+
+* Need to use RT::LoadConfig instead of requiring the config files directly.
+ Reported by: Jesse Vincent
+
+[Changes for 0.06 - 2004-05-10]
+
+* Support "make factory", "make initdb", "make dropdb"
+ for extensions that has its own initialdata and schema.
+
+[Changes for 0.05 - 2004-02-01]
+
+* Now installs libs to $RT::LocalPath/lib instead of perl's sitelib.
+
+* Now properly skips lib installation when WITH_SUBDIRS does not include lib.
+
+* Allow overriding prefix with $ENV{PREFIX}
+
+[Changes for 0.04 - 2004-01-10]
+
+* Update copyright years.
+
+* Make var/ directory writable
+
+* Some people insist on doing "make initialize-database" before "make install".
+
+* Add etc/initialdata insertion.
+
+* Take care of "inplace" layout by also probing in lib/RT.pm.
+
+* Now takes WITH_SUBDIRS to restrict the subdirectories to install.
+
+* Some POD cleanups.
+
+[Changes for 0.01 - 2003-12-15]
+
+* Initial release.
Added: Module-Install-RTx/MANIFEST
==============================================================================
--- (empty file)
+++ Module-Install-RTx/MANIFEST Thu Feb 24 16:29:47 2005
@@ -0,0 +1,15 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/WriteAll.pm
+lib/Module/Install/RTx.pm
+lib/Module/Install/RTx/Factory.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+SIGNATURE
+t/0-signature.t
+t/1-basic.t
Added: Module-Install-RTx/Makefile.PL
==============================================================================
--- (empty file)
+++ Module-Install-RTx/Makefile.PL Thu Feb 24 16:29:47 2005
@@ -0,0 +1,9 @@
+use inc::Module::Install;
+
+name ('Module-Install-RTx');
+abstract ('RT extension installer');
+version_from('lib/Module/Install/RTx.pm');
+requires ('Module::Install::Admin' => 0.29);
+license ('perl');
+
+&WriteAll( check_nmake => 0, sign => 1 );
Added: Module-Install-RTx/README
==============================================================================
--- (empty file)
+++ Module-Install-RTx/README Thu Feb 24 16:29:47 2005
@@ -0,0 +1,25 @@
+This is the README file for Module::Install::RTx, a helper module
+for RT extension writers to install files into an existing RT
+installation.
+
+Please type "perldoc Module::Install::RTx" after installation to see
+the module usage information.
+
+* Installation
+
+Module::Install::RTx uses the standard perl module install process:
+
+cpansign -v # optional; see SIGNATURE for details
+perl Makefile.PL
+make
+make test
+make install
+
+* Copyright
+
+Copyright 2003, 2004 by Autrijus Tang <autrijus at autrijus.org>
+
+All rights reserved. You can redistribute and/or modify
+this bundle under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.
Added: Module-Install-RTx/lib/Module/Install/RTx.pm
==============================================================================
--- (empty file)
+++ Module-Install-RTx/lib/Module/Install/RTx.pm Thu Feb 24 16:29:47 2005
@@ -0,0 +1,241 @@
+package Module::Install::RTx;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+$Module::Install::RTx::VERSION = '0.10';
+
+use strict;
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+sub RTx {
+ my ($self, $name) = @_;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+ $self->version_from (-e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm")
+ unless $self->version;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? (($prefix = $1), 0) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ }
+ else {
+ local @INC = (
+ @INC,
+ $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : (),
+ map {( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )} grep $_, @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to your RT.pm:") or exit;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ print "Using RT configurations from $INC{'RT.pm'}:\n";
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+
+ my %path;
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? (($with_subdirs = $1), 0) : 1 } @ARGV;
+ my %subdirs = map { $_ => 1 } split(/\s*,\s*/, $with_subdirs);
+
+ foreach (qw(bin etc html po sbin var)) {
+ next unless -d "$FindBin::Bin/$_";
+ next if %subdirs and !$subdirs{$_};
+ $self->no_index( directory => $_ );
+
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ my $args = join(', ', map "q($_)", %path);
+ $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
+ print "./$_\t=> $path{$_}\n" for sort keys %path;
+
+ if (my @dirs = map { (-D => $_) } grep $path{$_}, qw(bin html sbin)) {
+ my @po = map { (-o => $_) } grep -f, File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ($path{var} and -d $RT::MasonDataDir) {
+ my ($uid, $gid) = (stat($RT::MasonDataDir))[4, 5];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if (File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*")) {
+ # got schema, load factory module
+ $has_etc{schema}++;
+ $self->load('RTxFactory');
+ $self->postamble(<< ".");
+factory ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+
+dropdb ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+
+.
+ }
+ if (File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*")) {
+ $has_etc{acl}++;
+ }
+ if (-e 'etc/initialdata') {
+ $has_etc{initialdata}++;
+ }
+
+ $self->postamble("$postamble\n");
+ if (%subdirs and !$subdirs{'lib'}) {
+ $self->makemaker_args(
+ PM => { "" => "" },
+ )
+ }
+ else {
+ $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ }
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ }
+}
+
+sub RTxInit {
+ unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+ require RT;
+ RT::LoadConfig();
+ RT::ConnectToDatabase();
+
+ die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Module::Install::RTx - RT extension installer
+
+=head1 VERSION
+
+This document describes version 0.10 of Module::Install::RTx, released
+October 1, 2004.
+
+=head1 SYNOPSIS
+
+In the F<Makefile.PL> of the C<RTx-Foo> module:
+
+ use inc::Module::Install;
+
+ RTx('Foo');
+ author('Your Name <your at email.com>');
+ license('perl');
+
+ &WriteAll;
+
+=head1 DESCRIPTION
+
+This B<Module::Install> extension implements one function, C<RTx>,
+that takes the extension name as the only argument.
+
+It arranges for certain subdirectories to install into the installed
+RT location, but does not affect the usual C<lib> and C<t> directories.
+
+The directory mapping table is as below:
+
+ ./bin => $RT::LocalPath/bin
+ ./etc => $RT::LocalPath/etc/$NAME
+ ./html => $RT::MasonComponentRoot
+ ./po => $RT::LocalLexiconPath/$NAME
+ ./sbin => $RT::LocalPath/sbin
+ ./var => $RT::VarPath/$NAME
+
+Under the default RT3 layout in F</opt> and with the extension name
+C<Foo>, it becomes:
+
+ ./bin => /opt/rt3/local/bin
+ ./etc => /opt/rt3/local/etc/Foo
+ ./html => /opt/rt3/share/html
+ ./po => /opt/rt3/local/po/Foo
+ ./sbin => /opt/rt3/local/sbin
+ ./var => /opt/rt3/var/Foo
+
+By default, all these subdirectories will be installed with C<make install>.
+you can override this by setting the C<WITH_SUBDIRS> environment variable to
+a comma-delimited subdirectory list, such as C<html,sbin>.
+
+Alternatively, you can also specify the list as a command-line option to
+C<Makefile.PL>, like this:
+
+ perl Makefile.PL WITH_SUBDIRS=sbin
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item RTHOME
+
+Path to the RT installation that contains a valid F<lib/RT.pm>.
+
+=cut
+
+=head1 SEE ALSO
+
+L<Module::Install>
+
+L<http://www.bestpractical.com/rt/>
+
+=head1 AUTHORS
+
+Autrijus Tang <autrijus at autrijus.org>
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: Module-Install-RTx/lib/Module/Install/RTx/Factory.pm
==============================================================================
--- (empty file)
+++ Module-Install-RTx/lib/Module/Install/RTx/Factory.pm Thu Feb 24 16:29:47 2005
@@ -0,0 +1,477 @@
+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;
+ $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", "-I$lib_path",
+ "$RT::SbinPath/rt-setup-database",
+ "--action" => $action,
+ "--datadir" => "etc",
+ "--datafile" => "etc/initialdata",
+ "--dba" => $RT::DatabaseUser,
+ );
+ 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;
+}
Added: Module-Install-RTx/t/0-signature.t
==============================================================================
--- (empty file)
+++ Module-Install-RTx/t/0-signature.t Thu Feb 24 16:29:47 2005
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+print "1..1\n";
+
+if (!-s 'SIGNATURE') {
+ print "ok 1 # skip No signature file found\n";
+}
+elsif (!eval { require Module::Signature; 1 }) {
+ print "ok 1 # skip ",
+ "Next time around, consider install Module::Signature, ",
+ "so you can verify the integrity of this distribution.\n";
+}
+elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
+ print "ok 1 # skip ",
+ "Cannot connect to the keyserver\n";
+}
+else {
+ (Module::Signature::verify() == Module::Signature::SIGNATURE_OK())
+ or print "not ";
+ print "ok 1 # Valid signature\n";
+}
+
+__END__
Added: Module-Install-RTx/t/1-basic.t
==============================================================================
--- (empty file)
+++ Module-Install-RTx/t/1-basic.t Thu Feb 24 16:29:47 2005
@@ -0,0 +1,9 @@
+#!/usr/bin/perl
+
+print "1..1\n";
+
+require Module::Install::RTx;
+
+print "ok 1\n";
+
+1;
More information about the Rt-commit
mailing list