summaryrefslogtreecommitdiff
path: root/rt/devel/tools/factory
diff options
context:
space:
mode:
Diffstat (limited to 'rt/devel/tools/factory')
-rw-r--r--rt/devel/tools/factory372
1 files changed, 372 insertions, 0 deletions
diff --git a/rt/devel/tools/factory b/rt/devel/tools/factory
new file mode 100644
index 000000000..099d2db8c
--- /dev/null
+++ b/rt/devel/tools/factory
@@ -0,0 +1,372 @@
+#!/usr/bin/env perl
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+use strict;
+use DBI;
+
+die "Usage: $0 database namespace" if @ARGV != 2;
+
+my $database = shift;
+my $namespace = shift;
+
+my $CollectionBaseclass = 'RT::SearchBuilder';
+my $RecordBaseclass = 'RT::Record';
+
+my $driver = 'mysql';
+my $hostname = 'localhost';
+my $user = 'root';
+my $password = '';
+
+
+my $LicenseBlock = '';
+my $Attribution = '';
+
+my $dsn = "DBI:$driver:database=$database;host=$hostname";
+
+my $dbh = DBI->connect( $dsn, $user, $password );
+
+#get all tables out of database
+my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
+
+my ( %tablemap, $typemap, %modulemap );
+
+foreach my $table (@tables) {
+ $table =~ s/\`//g;
+ next if ($table eq 'sessions');
+ $table = ucfirst($table);
+ $table =~ s/field/Field/;
+ $table =~ s/group/Group/;
+ $table =~ s/custom/Custom/;
+ $table =~ s/member/Member/;
+ $table =~ s/Scripaction/ScripAction/g;
+ $table =~ s/condition/Condition/g;
+ $table =~ s/value/Value/;
+ $table =~ s/Acl/ACL/g;
+ $tablemap{$table} = $table;
+ $modulemap{$table} = $table;
+ if ( $table =~ /^(.*)s$/ ) {
+ $tablemap{$1} = $table;
+ $modulemap{$1} = $1;
+ }
+}
+$tablemap{'CreatedBy'} = 'User';
+$tablemap{'UpdatedBy'} = 'User';
+
+my %typemap;
+$typemap{'id'} = 'ro';
+$typemap{'Creator'} = 'auto';
+$typemap{'Created'} = 'auto';
+$typemap{'Updated'} = 'auto';
+$typemap{'UpdatedBy'} = 'auto';
+$typemap{'LastUpdated'} = 'auto';
+$typemap{'LastUpdatedBy'} = 'auto';
+
+foreach my $table (@tables) {
+ next if ($table eq 'sessions');
+ my $tablesingle = $table;
+ $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 $RecordInit = "";
+ my %fields;
+
+
+ my $introspection = $dbh->prepare("SELECT * from $table where id is null");
+ $introspection->execute();
+ my @names =@{ $introspection->{'NAME'}};
+ my @types = @{$introspection->{'TYPE'}};
+ my @is_blob = @{$introspection->{'mysql_is_blob'}};
+ my @is_num = @{$introspection->{'mysql_is_num'}};
+
+ my %blobness = ();
+ my %sqltypes = ();
+ my %numeric = ();
+ foreach my $name (@names) {
+ $sqltypes{$name} = shift @types;
+ $blobness{$name} = (shift @is_blob || "0");
+ $numeric{$name} = (shift @is_num || "0");
+ }
+
+
+ my $sth = $dbh->prepare("DESCRIBE $table");
+ $sth->execute;
+
+ while ( my $row = $sth->fetchrow_hashref() ) {
+ my $field = $row->{'Field'};
+ my $type = $row->{'Type'};
+ my $default = $row->{'Default'};
+ my $length = 0;
+ if ($type =~ /^(?:.*?)\((\d+)\)$/) {
+ $length = $1;
+ }
+ $fields{$field} = 1;
+
+ #generate the 'accessible' datastructure
+
+ no warnings 'uninitialized';
+
+ 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 .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
+ $ClassAccessible .= " type => '$type', default => '$default'},\n";
+
+ #generate pod for the accessible fields
+ $FieldsPod .= "
+=head2 $field
+
+Returns the current value of $field.
+(In the database, $field is stored as $type.)
+
+";
+
+ unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
+ $FieldsPod .= "
+
+=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 .= "
+=cut
+
+";
+
+ if ( $modulemap{$field} ) {
+ $FieldsPod .= "
+=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";
+
+ }
+
+ }
+
+ my $Create = "";
+ $CreatePod .= "\n=cut\n\n";
+
+ my $CollectionClass = $LicenseBlock . $Attribution .
+
+ "
+use $RecordClassName;
+
+use base '$CollectionBaseclass';
+
+sub Table { '$table'}
+
+sub _Init {
+";
+
+ if ( $fields{'SortOrder'} && $fields{'Name'} ) {
+ $CollectionClass .= "
+
+ # By default, order by SortOrder
+ \$self->OrderByCols(
+ { ALIAS => 'main',
+ FIELD => 'SortOrder',
+ ORDER => 'ASC' },
+ { ALIAS => 'main',
+ FIELD => 'Name',
+ ORDER => 'ASC' },
+ { ALIAS => 'main',
+ FIELD => 'id',
+ ORDER => 'ASC' },
+ );
+";
+ }
+ elsif ( $fields{'SortOrder'} ) {
+
+ $CollectionClass .= "
+
+ # By default, order by SortOrder
+ \$self->OrderByCols(
+ { ALIAS => 'main',
+ FIELD => 'SortOrder',
+ ORDER => 'ASC' },
+ { ALIAS => 'main',
+ FIELD => 'id',
+ ORDER => 'ASC' },
+ );
+";
+ }
+ $CollectionClass .= "
+ return ( \$self->SUPER::_Init(\@_) );
+}
+
+
+=head2 NewItem
+
+Returns an empty new $RecordClassName item
+
+=cut
+
+sub NewItem {
+ my \$self = shift;
+ return($RecordClassName->new(\$self->CurrentUser));
+}
+" . MagicImport($CollectionClassName);
+
+ my $RecordClassHeader = $Attribution . "
+";
+
+ foreach my $key ( keys %requirements ) {
+ $RecordClassHeader .= $requirements{$key} . "\n";
+ }
+ $RecordClassHeader .= "use base '$RecordBaseclass';
+
+sub Table {'$table'}
+
+";
+
+ my $RecordClass = $LicenseBlock . $RecordClassHeader . "
+
+$RecordInit
+
+$FieldsPod
+
+sub _CoreAccessible {
+ {
+
+$ClassAccessible
+ }
+};
+
+" . MagicImport($RecordClassName);
+
+ print "About to make $RecordClassPath, $CollectionClassPath\n";
+ `mkdir -p $path`;
+
+ open( RECORD, '>>', $RecordClassPath ) or die $!;
+ print RECORD $RecordClass;
+ close(RECORD);
+
+ open( COL, '>>', $CollectionClassPath ) or die $!;
+ print COL $CollectionClass;
+ close(COL);
+
+}
+
+sub MagicImport {
+ my $class = shift;
+
+ #if (exists \$warnings::{unimport}) {
+ # no warnings qw(redefine);
+
+ my $content = "RT::Base->_ImportOverlays();
+
+1;
+";
+ return $content;
+}
+
+
generated by cgit v1.2.1 (git 2.18.0) at 2024-09-23 22:25:45 +0000