[Bps-public-commit] Module-Install-RTx branch, remove-rtxfactory, created. 0.29-1-g4cff6f9

Kevin Falcone falcone at bestpractical.com
Wed Aug 15 18:30:30 EDT 2012


The branch, remove-rtxfactory has been created
        at  4cff6f97c8089c7da9cb300ebfa195728fa20cb3 (commit)

- Log -----------------------------------------------------------------
commit 4cff6f97c8089c7da9cb300ebfa195728fa20cb3
Author: Kevin Falcone <falcone at bestpractical.com>
Date:   Wed Aug 15 18:26:55 2012 -0400

    Remove unused Factory code

diff --git a/lib/Module/Install/RTx.pm b/lib/Module/Install/RTx.pm
index 959175b..75f4919 100644
--- a/lib/Module/Install/RTx.pm
+++ b/lib/Module/Install/RTx.pm
@@ -176,15 +176,6 @@ dropdb ::
     }
 }
 
-sub RTxInit {
-    unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
-    require RT;
-    RT::LoadConfig();
-    RT::ConnectToDatabase();
-
-    die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
-}
-
 # stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
 { my %word = (
     a     => -4,
diff --git a/lib/Module/Install/RTx/Factory.pm b/lib/Module/Install/RTx/Factory.pm
index f6c446b..81894e6 100644
--- a/lib/Module/Install/RTx/Factory.pm
+++ b/lib/Module/Install/RTx/Factory.pm
@@ -38,445 +38,4 @@ sub RTxInitDB {
     (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;
-}

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list