rt/sbin/factory

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