rt/sbin/factory

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