path: root/rt/devel/tools/factory

#!/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;
}