rt/devel/tools/factory

   1 #!/usr/bin/env perl
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
   7 #                                          <sales@bestpractical.com>
   8 #
   9 # (Except where explicitly superseded by other copyright notices)
  10 #
  11 #
  12 # LICENSE:
  13 #
  14 # This work is made available to you under the terms of Version 2 of
  15 # the GNU General Public License. A copy of that license should have
  16 # been provided with this software, but in any event can be snarfed
  17 # from www.gnu.org.
  18 #
  19 # This work is distributed in the hope that it will be useful, but
  20 # WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  22 # General Public License for more details.
  23 #
  24 # You should have received a copy of the GNU General Public License
  25 # along with this program; if not, write to the Free Software
  26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  27 # 02110-1301 or visit their web page on the internet at
  28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  29 #
  30 #
  31 # CONTRIBUTION SUBMISSION POLICY:
  32 #
  33 # (The following paragraph is not intended to limit the rights granted
  34 # to you to modify and distribute this software under the terms of
  35 # the GNU General Public License and is only of importance to you if
  36 # you choose to contribute your changes and enhancements to the
  37 # community by submitting them to Best Practical Solutions, LLC.)
  38 #
  39 # By intentionally submitting any modifications, corrections or
  40 # derivatives to this work, or any other work intended for use with
  41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  42 # you are the copyright holder for those contributions and you grant
  43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  44 # royalty-free, perpetual, license to use, copy, create derivative
  45 # works based on those contributions, and sublicense and distribute
  46 # those contributions and any derivatives thereof.
  47 #
  48 # END BPS TAGGED BLOCK }}}
  49 use strict;
  50 use DBI;
  51
  52 die "Usage: $0 database namespace" if @ARGV != 2;
  53
  54 my $database  = shift;
  55 my $namespace = shift;
  56
  57 my $CollectionBaseclass = 'RT::SearchBuilder';
  58 my $RecordBaseclass     = 'RT::Record';
  59
  60 my $driver   = 'mysql';
  61 my $hostname = 'localhost';
  62 my $user     = 'root';
  63 my $password = '';
  64
  65
  66 my $LicenseBlock = '';
  67 my $Attribution = '';
  68
  69 my $dsn = "DBI:$driver:database=$database;host=$hostname";
  70
  71 my $dbh = DBI->connect( $dsn, $user, $password );
  72
  73 #get all tables out of database
  74 my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
  75
  76 my ( %tablemap, $typemap, %modulemap );
  77
  78 foreach my $table (@tables) {
  79     $table =~ s/\`//g;
  80     next if ($table eq 'sessions');
  81         $table = ucfirst($table);
  82         $table =~ s/field/Field/;
  83         $table =~ s/group/Group/;
  84         $table =~ s/custom/Custom/;
  85         $table =~ s/member/Member/;
  86         $table =~ s/Scripaction/ScripAction/g;
  87         $table =~ s/condition/Condition/g;
  88         $table =~ s/value/Value/;
  89         $table =~ s/Acl/ACL/g;
  90     $tablemap{$table}  = $table;
  91     $modulemap{$table} = $table;
  92     if ( $table =~ /^(.*)s$/ ) {
  93         $tablemap{$1}  = $table;
  94         $modulemap{$1} = $1;
  95     }
  96 }
  97 $tablemap{'CreatedBy'} = 'User';
  98 $tablemap{'UpdatedBy'} = 'User';
  99
 100 my %typemap;
 101 $typemap{'id'}            = 'ro';
 102 $typemap{'Creator'}       = 'auto';
 103 $typemap{'Created'}       = 'auto';
 104 $typemap{'Updated'}       = 'auto';
 105 $typemap{'UpdatedBy'}     = 'auto';
 106 $typemap{'LastUpdated'}   = 'auto';
 107 $typemap{'LastUpdatedBy'} = 'auto';
 108
 109 foreach my $table (@tables) {
 110     next if ($table eq 'sessions');
 111     my $tablesingle = $table;
 112     $tablesingle =~ s/s$//;
 113     my $tableplural = $tablesingle . "s";
 114
 115     if ( $tablesingle eq 'ACL' ) {
 116         $tablesingle = "ACE";
 117         $tableplural = "ACL";
 118     }
 119
 120     my %requirements;
 121
 122     my $CollectionClassName = $namespace . "::" . $tableplural;
 123     my $RecordClassName     = $namespace . "::" . $tablesingle;
 124
 125     my $path = $namespace;
 126     $path =~ s/::/\//g;
 127
 128     my $RecordClassPath     = $path . "/" . $tablesingle . ".pm";
 129     my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
 130
 131     #create a collection class
 132     my $CreateInParams;
 133     my $CreateOutParams;
 134     my $ClassAccessible = "";
 135     my $FieldsPod       = "";
 136     my $CreatePod       = "";
 137     my $RecordInit      = "";
 138     my %fields;
 139
 140
 141     my $introspection = $dbh->prepare("SELECT * from $table where id is null");
 142     $introspection->execute();
 143     my @names =@{ $introspection->{'NAME'}};
 144     my @types = @{$introspection->{'TYPE'}};
 145     my @is_blob = @{$introspection->{'mysql_is_blob'}};
 146     my @is_num = @{$introspection->{'mysql_is_num'}};
 147
 148     my %blobness = ();
 149     my %sqltypes = ();
 150     my %numeric = ();
 151     foreach my $name (@names) {
 152         $sqltypes{$name} = shift @types;
 153         $blobness{$name} = (shift @is_blob || "0");
 154         $numeric{$name} = (shift @is_num || "0");
 155     }
 156
 157
 158     my $sth = $dbh->prepare("DESCRIBE $table");
 159     $sth->execute;
 160
 161     while ( my $row = $sth->fetchrow_hashref() ) {
 162         my $field   = $row->{'Field'};
 163         my $type    = $row->{'Type'};
 164         my $default = $row->{'Default'};
 165         my $length = 0;
 166         if ($type =~ /^(?:.*?)\((\d+)\)$/) {
 167                 $length = $1;
 168         }
 169         $fields{$field} = 1;
 170
 171         #generate the 'accessible' datastructure
 172
 173         no warnings 'uninitialized';
 174
 175         if ( $typemap{$field} eq 'auto' ) {
 176             $ClassAccessible .= "        $field =>
 177                 {read => 1, auto => 1,";
 178         }
 179         elsif ( $typemap{$field} eq 'ro' ) {
 180             $ClassAccessible .= "        $field =>
 181                 {read => 1,";
 182         }
 183         else {
 184             $ClassAccessible .= "        $field =>
 185                 {read => 1, write => 1,";
 186
 187         }
 188         $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length,  is_blob => $blobness{$field},  is_numeric => $numeric{$field}, ";
 189         $ClassAccessible .= " type => '$type', default => '$default'},\n";
 190
 191         #generate pod for the accessible fields
 192         $FieldsPod .= "
 193 =head2 $field
 194
 195 Returns the current value of $field.
 196 (In the database, $field is stored as $type.)
 197
 198 ";
 199
 200         unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
 201             $FieldsPod .= "
 202
 203 =head2 Set$field VALUE
 204
 205
 206 Set $field to VALUE.
 207 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 208 (In the database, $field will be stored as a $type.)
 209
 210 ";
 211         }
 212
 213         $FieldsPod .= "
 214 =cut
 215
 216 ";
 217
 218         if ( $modulemap{$field} ) {
 219             $FieldsPod .= "
 220 =head2 ${field}Obj
 221
 222 Returns the $modulemap{$field} Object which has the id returned by $field
 223
 224
 225 =cut
 226
 227 sub ${field}Obj {
 228         my \$self = shift;
 229         my \$$field =  ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
 230         \$$field->Load(\$self->__Value('$field'));
 231         return(\$$field);
 232 }
 233 ";
 234             $requirements{ $tablemap{$field} } =
 235               "use ${namespace}::$modulemap{$field};";
 236
 237         }
 238
 239         unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
 240
 241             #generate create statement
 242             $CreateInParams .= "                $field => '$default',\n";
 243             $CreateOutParams .=
 244               "                         $field => \$args{'$field'},\n";
 245
 246             #gerenate pod for the create statement
 247             $CreatePod .= "  $type '$field'";
 248             $CreatePod .= " defaults to '$default'" if ($default);
 249             $CreatePod .= ".\n";
 250
 251         }
 252
 253     }
 254
 255     my $Create = "";
 256     $CreatePod .= "\n=cut\n\n";
 257
 258     my $CollectionClass = $LicenseBlock . $Attribution .
 259
 260       "
 261 use $RecordClassName;
 262
 263 use base '$CollectionBaseclass';
 264
 265 sub Table { '$table'}
 266
 267 sub _Init {
 268 ";
 269
 270     if ( $fields{'SortOrder'} && $fields{'Name'} ) {
 271         $CollectionClass .= "
 272
 273   # By default, order by SortOrder
 274   \$self->OrderByCols(
 275          { ALIAS => 'main',
 276            FIELD => 'SortOrder',
 277            ORDER => 'ASC' },
 278          { ALIAS => 'main',
 279            FIELD => 'Name',
 280            ORDER => 'ASC' },
 281          { ALIAS => 'main',
 282            FIELD => 'id',
 283            ORDER => 'ASC' },
 284      );
 285 ";
 286     }
 287     elsif ( $fields{'SortOrder'} ) {
 288
 289         $CollectionClass .= "
 290
 291   # By default, order by SortOrder
 292   \$self->OrderByCols(
 293          { ALIAS => 'main',
 294            FIELD => 'SortOrder',
 295            ORDER => 'ASC' },
 296          { ALIAS => 'main',
 297            FIELD => 'id',
 298            ORDER => 'ASC' },
 299      );
 300 ";
 301     }
 302     $CollectionClass .= "
 303     return ( \$self->SUPER::_Init(\@_) );
 304 }
 305
 306
 307 =head2 NewItem
 308
 309 Returns an empty new $RecordClassName item
 310
 311 =cut
 312
 313 sub NewItem {
 314     my \$self = shift;
 315     return($RecordClassName->new(\$self->CurrentUser));
 316 }
 317 " . MagicImport($CollectionClassName);
 318
 319     my $RecordClassHeader = $Attribution . "
 320 ";
 321
 322     foreach my $key ( keys %requirements ) {
 323         $RecordClassHeader .= $requirements{$key} . "\n";
 324     }
 325     $RecordClassHeader .= "use base '$RecordBaseclass';
 326
 327 sub Table {'$table'}
 328
 329 ";
 330
 331     my $RecordClass = $LicenseBlock .  $RecordClassHeader . "
 332
 333 $RecordInit
 334
 335 $FieldsPod
 336
 337 sub _CoreAccessible {
 338     {
 339
 340 $ClassAccessible
 341  }
 342 };
 343
 344 " . MagicImport($RecordClassName);
 345
 346     print "About to make $RecordClassPath, $CollectionClassPath\n";
 347     `mkdir -p $path`;
 348
 349     open( RECORD, '>>', $RecordClassPath ) or die $!;
 350     print RECORD $RecordClass;
 351     close(RECORD);
 352
 353     open( COL, '>>', $CollectionClassPath ) or die $!;
 354     print COL $CollectionClass;
 355     close(COL);
 356
 357 }
 358
 359 sub MagicImport {
 360     my $class = shift;
 361
 362     #if (exists \$warnings::{unimport})  {
 363     #        no warnings qw(redefine);
 364
 365     my $content = "RT::Base->_ImportOverlays();
 366
 367 1;
 368 ";
 369     return $content;
 370 }
 371
 372