#!/usr/bin/perl -w
# BEGIN BPS TAGGED BLOCK {{{
# 
# COPYRIGHT:
#  
# This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC 
#                                          <jesse@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., 675 Mass Ave, Cambridge, MA 02139, USA.
# 
# 
# 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;

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 = << '.';
# BEGIN BPS TAGGED BLOCK {{{
# 
# COPYRIGHT:
#  
# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC 
#                                          <jesse@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., 675 Mass Ave, Cambridge, MA 02139, USA.
# 
# 
# 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 }}}
.

my $Attribution = << '.';
# Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.  
# 
# !! DO NOT EDIT THIS FILE !!
#

use strict;
.

my $dsn = "DBI:$driver:database=$database;host=$hostname";

my $dbh = DBI->connect( $dsn, $user, $password );

#get all tables out of database
my @tables = $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 = "
sub Create {
    my \$self = shift;
    my \%args = ( 
$CreateInParams
		  \@_);
    \$self->SUPER::Create(
$CreateOutParams);

}
";
    $CreatePod .= "\n=cut\n\n";

    my $CollectionClass = $LicenseBlock . $Attribution .

      "

=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 .= "

  # 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 . "

=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 . "

$RecordInit

=head2 Create PARAMHASH

Create takes a hash of values and creates a row in the database:

$CreatePod

$Create

$FieldsPod

sub _CoreAccessible {
    {
     
$ClassAccessible
 }
};

" . MagicImport($RecordClassName);

    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 MagicImport {
    my $class = shift;

    #if (exists \$warnings::{unimport})  {
    #        no warnings qw(redefine);

    my $path = $class;
    $path =~ s#::#/#gi;


    my $content = "
        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.

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;
}

# }}}