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-2015 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 warnings;
  51 use DBI;
  52
  53 die "Usage: $0 database namespace" if @ARGV != 2;
  54
  55 my $database  = shift;
  56 my $namespace = shift;
  57
  58 my $CollectionBaseclass = 'RT::SearchBuilder';
  59 my $RecordBaseclass     = 'RT::Record';
  60
  61 my $driver   = 'mysql';
  62 my $hostname = 'localhost';
  63 my $user     = 'root';
  64 my $password = '';
  65
  66
  67 my $LicenseBlock = '';
  68 my $Attribution = '';
  69
  70 my $dsn = "DBI:$driver:database=$database;host=$hostname";
  71
  72 my $dbh = DBI->connect( $dsn, $user, $password );
  73
  74 #get all tables out of database
  75 my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
  76
  77 my ( %tablemap, $typemap, %modulemap );
  78
  79 foreach my $table (@tables) {
  80     $table =~ s/\`//g;
  81     next if ($table eq 'sessions');
  82         $table = ucfirst($table);
  83         $table =~ s/field/Field/;
  84         $table =~ s/group/Group/;
  85         $table =~ s/custom/Custom/;
  86         $table =~ s/member/Member/;
  87         $table =~ s/Scripaction/ScripAction/g;
  88         $table =~ s/condition/Condition/g;
  89         $table =~ s/value/Value/;
  90         $table =~ s/Acl/ACL/g;
  91     $tablemap{$table}  = $table;
  92     $modulemap{$table} = $table;
  93     if ( $table =~ /^(.*)s$/ ) {
  94         $tablemap{$1}  = $table;
  95         $modulemap{$1} = $1;
  96     }
  97 }
  98 $tablemap{'CreatedBy'} = 'User';
  99 $tablemap{'UpdatedBy'} = 'User';
 100
 101 my %typemap;
 102 $typemap{'id'}            = 'ro';
 103 $typemap{'Creator'}       = 'auto';
 104 $typemap{'Created'}       = 'auto';
 105 $typemap{'Updated'}       = 'auto';
 106 $typemap{'UpdatedBy'}     = 'auto';
 107 $typemap{'LastUpdated'}   = 'auto';
 108 $typemap{'LastUpdatedBy'} = 'auto';
 109
 110 foreach my $table (@tables) {
 111     next if ($table eq 'sessions');
 112     my $tablesingle = $table;
 113     $tablesingle =~ s/s$//;
 114     my $tableplural = $tablesingle . "s";
 115
 116     if ( $tablesingle eq 'ACL' ) {
 117         $tablesingle = "ACE";
 118         $tableplural = "ACL";
 119     }
 120
 121     my %requirements;
 122
 123     my $CollectionClassName = $namespace . "::" . $tableplural;
 124     my $RecordClassName     = $namespace . "::" . $tablesingle;
 125
 126     my $path = $namespace;
 127     $path =~ s/::/\//g;
 128
 129     my $RecordClassPath     = $path . "/" . $tablesingle . ".pm";
 130     my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
 131
 132     #create a collection class
 133     my $CreateInParams;
 134     my $CreateOutParams;
 135     my $ClassAccessible = "";
 136     my $FieldsPod       = "";
 137     my $CreatePod       = "";
 138     my $RecordInit      = "";
 139     my %fields;
 140
 141
 142     my $introspection = $dbh->prepare("SELECT * from $table where id is null");
 143     $introspection->execute();
 144     my @names =@{ $introspection->{'NAME'}};
 145     my @types = @{$introspection->{'TYPE'}};
 146     my @is_blob = @{$introspection->{'mysql_is_blob'}};
 147     my @is_num = @{$introspection->{'mysql_is_num'}};
 148
 149     my %blobness = ();
 150     my %sqltypes = ();
 151     my %numeric = ();
 152     foreach my $name (@names) {
 153         $sqltypes{$name} = shift @types;
 154         $blobness{$name} = (shift @is_blob || "0");
 155         $numeric{$name} = (shift @is_num || "0");
 156     }
 157
 158
 159     my $sth = $dbh->prepare("DESCRIBE $table");
 160     $sth->execute;
 161
 162     while ( my $row = $sth->fetchrow_hashref() ) {
 163         my $field   = $row->{'Field'};
 164         my $type    = $row->{'Type'};
 165         my $default = $row->{'Default'};
 166         my $length = 0;
 167         if ($type =~ /^(?:.*?)\((\d+)\)$/) {
 168                 $length = $1;
 169         }
 170         $fields{$field} = 1;
 171
 172         #generate the 'accessible' datastructure
 173
 174         no warnings 'uninitialized';
 175
 176         if ( $typemap{$field} eq 'auto' ) {
 177             $ClassAccessible .= "        $field =>
 178                 {read => 1, auto => 1,";
 179         }
 180         elsif ( $typemap{$field} eq 'ro' ) {
 181             $ClassAccessible .= "        $field =>
 182                 {read => 1,";
 183         }
 184         else {
 185             $ClassAccessible .= "        $field =>
 186                 {read => 1, write => 1,";
 187
 188         }
 189         $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length,  is_blob => $blobness{$field},  is_numeric => $numeric{$field}, ";
 190         $ClassAccessible .= " type => '$type', default => '$default'},\n";
 191
 192         #generate pod for the accessible fields
 193         $FieldsPod .= "
 194 =head2 $field
 195
 196 Returns the current value of $field.
 197 (In the database, $field is stored as $type.)
 198
 199 ";
 200
 201         unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
 202             $FieldsPod .= "
 203
 204 =head2 Set$field VALUE
 205
 206
 207 Set $field to VALUE.
 208 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 209 (In the database, $field will be stored as a $type.)
 210
 211 ";
 212         }
 213
 214         $FieldsPod .= "
 215 =cut
 216
 217 ";
 218
 219         if ( $modulemap{$field} ) {
 220             $FieldsPod .= "
 221 =head2 ${field}Obj
 222
 223 Returns the $modulemap{$field} Object which has the id returned by $field
 224
 225
 226 =cut
 227
 228 sub ${field}Obj {
 229         my \$self = shift;
 230         my \$$field =  ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
 231         \$$field->Load(\$self->__Value('$field'));
 232         return(\$$field);
 233 }
 234 ";
 235             $requirements{ $tablemap{$field} } =
 236               "use ${namespace}::$modulemap{$field};";
 237
 238         }
 239
 240         unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
 241
 242             #generate create statement
 243             $CreateInParams .= "                $field => '$default',\n";
 244             $CreateOutParams .=
 245               "                         $field => \$args{'$field'},\n";
 246
 247             #gerenate pod for the create statement
 248             $CreatePod .= "  $type '$field'";
 249             $CreatePod .= " defaults to '$default'" if ($default);
 250             $CreatePod .= ".\n";
 251
 252         }
 253
 254     }
 255
 256     my $Create = "";
 257     $CreatePod .= "\n=cut\n\n";
 258
 259     my $CollectionClass = $LicenseBlock . $Attribution .
 260
 261       "
 262 use $RecordClassName;
 263
 264 use base '$CollectionBaseclass';
 265
 266 sub Table { '$table'}
 267
 268 sub _Init {
 269 ";
 270
 271     if ( $fields{'SortOrder'} && $fields{'Name'} ) {
 272         $CollectionClass .= "
 273
 274   # By default, order by SortOrder
 275   \$self->OrderByCols(
 276          { ALIAS => 'main',
 277            FIELD => 'SortOrder',
 278            ORDER => 'ASC' },
 279          { ALIAS => 'main',
 280            FIELD => 'Name',
 281            ORDER => 'ASC' },
 282          { ALIAS => 'main',
 283            FIELD => 'id',
 284            ORDER => 'ASC' },
 285      );
 286 ";
 287     }
 288     elsif ( $fields{'SortOrder'} ) {
 289
 290         $CollectionClass .= "
 291
 292   # By default, order by SortOrder
 293   \$self->OrderByCols(
 294          { ALIAS => 'main',
 295            FIELD => 'SortOrder',
 296            ORDER => 'ASC' },
 297          { ALIAS => 'main',
 298            FIELD => 'id',
 299            ORDER => 'ASC' },
 300      );
 301 ";
 302     }
 303     $CollectionClass .= "
 304     return ( \$self->SUPER::_Init(\@_) );
 305 }
 306
 307
 308 =head2 NewItem
 309
 310 Returns an empty new $RecordClassName item
 311
 312 =cut
 313
 314 sub NewItem {
 315     my \$self = shift;
 316     return($RecordClassName->new(\$self->CurrentUser));
 317 }
 318 " . MagicImport($CollectionClassName);
 319
 320     my $RecordClassHeader = $Attribution . "
 321 ";
 322
 323     foreach my $key ( keys %requirements ) {
 324         $RecordClassHeader .= $requirements{$key} . "\n";
 325     }
 326     $RecordClassHeader .= "use base '$RecordBaseclass';
 327
 328 sub Table {'$table'}
 329
 330 ";
 331
 332     my $RecordClass = $LicenseBlock .  $RecordClassHeader . "
 333
 334 $RecordInit
 335
 336 $FieldsPod
 337
 338 sub _CoreAccessible {
 339     {
 340
 341 $ClassAccessible
 342  }
 343 };
 344
 345 " . MagicImport($RecordClassName);
 346
 347     print "About to make $RecordClassPath, $CollectionClassPath\n";
 348     `mkdir -p $path`;
 349
 350     open( RECORD, '>>', $RecordClassPath ) or die $!;
 351     print RECORD $RecordClass;
 352     close(RECORD);
 353
 354     open( COL, '>>', $CollectionClassPath ) or die $!;
 355     print COL $CollectionClass;
 356     close(COL);
 357
 358 }
 359
 360 sub MagicImport {
 361     my $class = shift;
 362
 363     #if (exists \$warnings::{unimport})  {
 364     #        no warnings qw(redefine);
 365
 366     my $content = "RT::Base->_ImportOverlays();
 367
 368 1;
 369 ";
 370     return $content;
 371 }
 372
 373