rt/sbin/factory

   1 #!/usr/bin/perl -w
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2005 Best Practical Solutions, LLC
   7 #                                          <jesse@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., 675 Mass Ave, Cambridge, MA 02139, USA.
  27 #
  28 #
  29 # CONTRIBUTION SUBMISSION POLICY:
  30 #
  31 # (The following paragraph is not intended to limit the rights granted
  32 # to you to modify and distribute this software under the terms of
  33 # the GNU General Public License and is only of importance to you if
  34 # you choose to contribute your changes and enhancements to the
  35 # community by submitting them to Best Practical Solutions, LLC.)
  36 #
  37 # By intentionally submitting any modifications, corrections or
  38 # derivatives to this work, or any other work intended for use with
  39 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  40 # you are the copyright holder for those contributions and you grant
  41 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  42 # royalty-free, perpetual, license to use, copy, create derivative
  43 # works based on those contributions, and sublicense and distribute
  44 # those contributions and any derivatives thereof.
  45 #
  46 # END BPS TAGGED BLOCK }}}
  47 use strict;
  48 use DBI;
  49
  50 my $database  = shift;
  51 my $namespace = shift;
  52
  53 my $CollectionBaseclass = 'RT::SearchBuilder';
  54 my $RecordBaseclass     = 'RT::Record';
  55
  56 my $driver   = 'mysql';
  57 my $hostname = 'localhost';
  58 my $user     = 'root';
  59 my $password = '';
  60
  61
  62 my $LicenseBlock = << '.';
  63 # BEGIN BPS TAGGED BLOCK {{{
  64 #
  65 # COPYRIGHT:
  66 #
  67 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
  68 #                                          <jesse@bestpractical.com>
  69 #
  70 # (Except where explicitly superseded by other copyright notices)
  71 #
  72 #
  73 # LICENSE:
  74 #
  75 # This work is made available to you under the terms of Version 2 of
  76 # the GNU General Public License. A copy of that license should have
  77 # been provided with this software, but in any event can be snarfed
  78 # from www.gnu.org.
  79 #
  80 # This work is distributed in the hope that it will be useful, but
  81 # WITHOUT ANY WARRANTY; without even the implied warranty of
  82 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  83 # General Public License for more details.
  84 #
  85 # You should have received a copy of the GNU General Public License
  86 # along with this program; if not, write to the Free Software
  87 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  88 #
  89 #
  90 # CONTRIBUTION SUBMISSION POLICY:
  91 #
  92 # (The following paragraph is not intended to limit the rights granted
  93 # to you to modify and distribute this software under the terms of
  94 # the GNU General Public License and is only of importance to you if
  95 # you choose to contribute your changes and enhancements to the
  96 # community by submitting them to Best Practical Solutions, LLC.)
  97 #
  98 # By intentionally submitting any modifications, corrections or
  99 # derivatives to this work, or any other work intended for use with
 100 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
 101 # you are the copyright holder for those contributions and you grant
 102 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
 103 # royalty-free, perpetual, license to use, copy, create derivative
 104 # works based on those contributions, and sublicense and distribute
 105 # those contributions and any derivatives thereof.
 106 #
 107 # END BPS TAGGED BLOCK }}}
 108 .
 109
 110 my $Attribution = << '.';
 111 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
 112 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
 113 #
 114 # !! DO NOT EDIT THIS FILE !!
 115 #
 116
 117 use strict;
 118 .
 119
 120 my $dsn = "DBI:$driver:database=$database;host=$hostname";
 121
 122 my $dbh = DBI->connect( $dsn, $user, $password );
 123
 124 #get all tables out of database
 125 my @tables = $dbh->tables();
 126
 127 my ( %tablemap, $typemap, %modulemap );
 128
 129 foreach my $table (@tables) {
 130     $table =~ s/\`//g;
 131     next if ($table eq 'sessions');
 132         $table = ucfirst($table);
 133         $table =~ s/field/Field/;
 134         $table =~ s/group/Group/;
 135         $table =~ s/custom/Custom/;
 136         $table =~ s/member/Member/;
 137         $table =~ s/Scripaction/ScripAction/g;
 138         $table =~ s/condition/Condition/g;
 139         $table =~ s/value/Value/;
 140         $table =~ s/Acl/ACL/g;
 141     $tablemap{$table}  = $table;
 142     $modulemap{$table} = $table;
 143     if ( $table =~ /^(.*)s$/ ) {
 144         $tablemap{$1}  = $table;
 145         $modulemap{$1} = $1;
 146     }
 147 }
 148 $tablemap{'CreatedBy'} = 'User';
 149 $tablemap{'UpdatedBy'} = 'User';
 150
 151 my %typemap;
 152 $typemap{'id'}            = 'ro';
 153 $typemap{'Creator'}       = 'auto';
 154 $typemap{'Created'}       = 'auto';
 155 $typemap{'Updated'}       = 'auto';
 156 $typemap{'UpdatedBy'}     = 'auto';
 157 $typemap{'LastUpdated'}   = 'auto';
 158 $typemap{'LastUpdatedBy'} = 'auto';
 159
 160 foreach my $table (@tables) {
 161     next if ($table eq 'sessions');
 162     my $tablesingle = $table;
 163     $tablesingle =~ s/s$//;
 164     my $tableplural = $tablesingle . "s";
 165
 166     if ( $tablesingle eq 'ACL' ) {
 167         $tablesingle = "ACE";
 168         $tableplural = "ACL";
 169     }
 170
 171     my %requirements;
 172
 173     my $CollectionClassName = $namespace . "::" . $tableplural;
 174     my $RecordClassName     = $namespace . "::" . $tablesingle;
 175
 176     my $path = $namespace;
 177     $path =~ s/::/\//g;
 178
 179     my $RecordClassPath     = $path . "/" . $tablesingle . ".pm";
 180     my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
 181
 182     #create a collection class
 183     my $CreateInParams;
 184     my $CreateOutParams;
 185     my $ClassAccessible = "";
 186     my $FieldsPod       = "";
 187     my $CreatePod       = "";
 188     my $RecordInit      = "";
 189     my %fields;
 190
 191
 192     my $introspection = $dbh->prepare("SELECT * from $table where id is null");
 193     $introspection->execute();
 194     my @names =@{ $introspection->{'NAME'}};
 195     my @types = @{$introspection->{'TYPE'}};
 196     my @is_blob = @{$introspection->{'mysql_is_blob'}};
 197     my @is_num = @{$introspection->{'mysql_is_num'}};
 198
 199     my %blobness = ();
 200     my %sqltypes = ();
 201     my %numeric = ();
 202     foreach my $name (@names) {
 203         $sqltypes{$name} = shift @types;
 204         $blobness{$name} = (shift @is_blob || "0");
 205         $numeric{$name} = (shift @is_num || "0");
 206     }
 207
 208
 209     my $sth = $dbh->prepare("DESCRIBE $table");
 210     $sth->execute;
 211
 212     while ( my $row = $sth->fetchrow_hashref() ) {
 213         my $field   = $row->{'Field'};
 214         my $type    = $row->{'Type'};
 215         my $default = $row->{'Default'};
 216         my $length = 0;
 217         if ($type =~ /^(?:.*?)\((\d+)\)$/) {
 218                 $length = $1;
 219         }
 220         $fields{$field} = 1;
 221
 222         #generate the 'accessible' datastructure
 223
 224         no warnings 'uninitialized';
 225
 226         if ( $typemap{$field} eq 'auto' ) {
 227             $ClassAccessible .= "        $field =>
 228                 {read => 1, auto => 1,";
 229         }
 230         elsif ( $typemap{$field} eq 'ro' ) {
 231             $ClassAccessible .= "        $field =>
 232                 {read => 1,";
 233         }
 234         else {
 235             $ClassAccessible .= "        $field =>
 236                 {read => 1, write => 1,";
 237
 238         }
 239         $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length,  is_blob => $blobness{$field},  is_numeric => $numeric{$field}, ";
 240         $ClassAccessible .= " type => '$type', default => '$default'},\n";
 241
 242         #generate pod for the accessible fields
 243         $FieldsPod .= "
 244 =head2 $field
 245
 246 Returns the current value of $field.
 247 (In the database, $field is stored as $type.)
 248
 249 ";
 250
 251         unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
 252             $FieldsPod .= "
 253
 254 =head2 Set$field VALUE
 255
 256
 257 Set $field to VALUE.
 258 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
 259 (In the database, $field will be stored as a $type.)
 260
 261 ";
 262         }
 263
 264         $FieldsPod .= "
 265 =cut
 266
 267 ";
 268
 269         if ( $modulemap{$field} ) {
 270             $FieldsPod .= "
 271 =head2 ${field}Obj
 272
 273 Returns the $modulemap{$field} Object which has the id returned by $field
 274
 275
 276 =cut
 277
 278 sub ${field}Obj {
 279         my \$self = shift;
 280         my \$$field =  ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
 281         \$$field->Load(\$self->__Value('$field'));
 282         return(\$$field);
 283 }
 284 ";
 285             $requirements{ $tablemap{$field} } =
 286               "use ${namespace}::$modulemap{$field};";
 287
 288         }
 289
 290         unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
 291
 292             #generate create statement
 293             $CreateInParams .= "                $field => '$default',\n";
 294             $CreateOutParams .=
 295               "                         $field => \$args{'$field'},\n";
 296
 297             #gerenate pod for the create statement
 298             $CreatePod .= "  $type '$field'";
 299             $CreatePod .= " defaults to '$default'" if ($default);
 300             $CreatePod .= ".\n";
 301
 302         }
 303
 304     }
 305
 306     my $Create = "
 307 sub Create {
 308     my \$self = shift;
 309     my \%args = (
 310 $CreateInParams
 311                   \@_);
 312     \$self->SUPER::Create(
 313 $CreateOutParams);
 314
 315 }
 316 ";
 317     $CreatePod .= "\n=cut\n\n";
 318
 319     my $CollectionClass = $LicenseBlock . $Attribution .
 320
 321       "
 322
 323 =head1 NAME
 324
 325   $CollectionClassName -- Class Description
 326
 327 =head1 SYNOPSIS
 328
 329   use $CollectionClassName
 330
 331 =head1 DESCRIPTION
 332
 333
 334 =head1 METHODS
 335
 336 =cut
 337
 338 package $CollectionClassName;
 339
 340 use $CollectionBaseclass;
 341 use $RecordClassName;
 342
 343 use vars qw( \@ISA );
 344 \@ISA= qw($CollectionBaseclass);
 345
 346
 347 sub _Init {
 348     my \$self = shift;
 349     \$self->{'table'} = '$table';
 350     \$self->{'primary_key'} = 'id';
 351
 352 ";
 353
 354     if ( $fields{'SortOrder'} ) {
 355
 356         $CollectionClass .= "
 357
 358   # By default, order by SortOrder
 359   \$self->OrderByCols(
 360          { ALIAS => 'main',
 361            FIELD => 'SortOrder',
 362            ORDER => 'ASC' },
 363          { ALIAS => 'main',
 364            FIELD => 'id',
 365            ORDER => 'ASC' },
 366      );
 367 ";
 368     }
 369     $CollectionClass .= "
 370     return ( \$self->SUPER::_Init(\@_) );
 371 }
 372
 373
 374 =head2 NewItem
 375
 376 Returns an empty new $RecordClassName item
 377
 378 =cut
 379
 380 sub NewItem {
 381     my \$self = shift;
 382     return($RecordClassName->new(\$self->CurrentUser));
 383 }
 384 " . MagicImport($CollectionClassName);
 385
 386     my $RecordClassHeader = $Attribution . "
 387
 388 =head1 NAME
 389
 390 $RecordClassName
 391
 392
 393 =head1 SYNOPSIS
 394
 395 =head1 DESCRIPTION
 396
 397 =head1 METHODS
 398
 399 =cut
 400
 401 package $RecordClassName;
 402 use $RecordBaseclass;
 403 ";
 404
 405     foreach my $key ( keys %requirements ) {
 406         $RecordClassHeader .= $requirements{$key} . "\n";
 407     }
 408     $RecordClassHeader .= "
 409
 410 use vars qw( \@ISA );
 411 \@ISA= qw( $RecordBaseclass );
 412
 413 sub _Init {
 414   my \$self = shift;
 415
 416   \$self->Table('$table');
 417   \$self->SUPER::_Init(\@_);
 418 }
 419
 420 ";
 421
 422     my $RecordClass = $LicenseBlock .  $RecordClassHeader . "
 423
 424 $RecordInit
 425
 426 =head2 Create PARAMHASH
 427
 428 Create takes a hash of values and creates a row in the database:
 429
 430 $CreatePod
 431
 432 $Create
 433
 434 $FieldsPod
 435
 436 sub _CoreAccessible {
 437     {
 438
 439 $ClassAccessible
 440  }
 441 };
 442
 443 " . MagicImport($RecordClassName);
 444
 445     print "About to make $RecordClassPath, $CollectionClassPath\n";
 446     `mkdir -p $path`;
 447
 448     open( RECORD, ">$RecordClassPath" );
 449     print RECORD $RecordClass;
 450     close(RECORD);
 451
 452     open( COL, ">$CollectionClassPath" );
 453     print COL $CollectionClass;
 454     close(COL);
 455
 456 }
 457
 458 sub MagicImport {
 459     my $class = shift;
 460
 461     #if (exists \$warnings::{unimport})  {
 462     #        no warnings qw(redefine);
 463
 464     my $path = $class;
 465     $path =~ s#::#/#gi;
 466
 467
 468     my $content = "
 469         eval \"require @{[$class]}_Overlay\";
 470         if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
 471             die \$@;
 472         };
 473
 474         eval \"require @{[$class]}_Vendor\";
 475         if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
 476             die \$@;
 477         };
 478
 479         eval \"require @{[$class]}_Local\";
 480         if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
 481             die \$@;
 482         };
 483
 484
 485
 486
 487 =head1 SEE ALSO
 488
 489 This class allows \"overlay\" methods to be placed
 490 into the following files _Overlay is for a System overlay by the original author,
 491 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
 492
 493 These overlay files can contain new subs or subs to replace existing subs in this module.
 494
 495 Each of these files should begin with the line
 496
 497    no warnings qw(redefine);
 498
 499 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
 500
 501 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local
 502
 503 =cut
 504
 505
 506 1;
 507 ";
 508
 509     return $content;
 510 }
 511
 512 # }}}
 513