4 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
6 # (Except where explictly superceded by other copyright notices)
8 # This work is made available to you under the terms of Version 2 of
9 # the GNU General Public License. A copy of that license should have
10 # been provided with this software, but in any event can be snarfed
13 # This work is distributed in the hope that it will be useful, but
14 # WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # General Public License for more details.
18 # Unless otherwise specified, all modifications, corrections or
19 # extensions to this work which alter its source code become the
20 # property of Best Practical Solutions, LLC when submitted for
21 # inclusion in the work.
29 my $namespace = shift;
31 my $CollectionBaseclass = 'RT::SearchBuilder';
32 my $RecordBaseclass = 'RT::Record';
35 my $hostname = 'localhost';
40 my $LicenseBlock = << '.';
43 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
45 # (Except where explictly superceded by other copyright notices)
47 # This work is made available to you under the terms of Version 2 of
48 # the GNU General Public License. A copy of that license should have
49 # been provided with this software, but in any event can be snarfed
52 # This work is distributed in the hope that it will be useful, but
53 # WITHOUT ANY WARRANTY; without even the implied warranty of
54 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
55 # General Public License for more details.
57 # Unless otherwise specified, all modifications, corrections or
58 # extensions to this work which alter its source code become the
59 # property of Best Practical Solutions, LLC when submitted for
60 # inclusion in the work.
67 my $Attribution = << '.';
68 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
69 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
71 # !! DO NOT EDIT THIS FILE !!
77 my $dsn = "DBI:$driver:database=$database;host=$hostname";
79 my $dbh = DBI->connect( $dsn, $user, $password );
81 #get all tables out of database
82 my @tables = $dbh->tables();
84 my ( %tablemap, $typemap, %modulemap );
86 foreach my $table (@tables) {
87 next if ($table eq 'sessions');
88 $tablemap{$table} = $table;
89 $modulemap{$table} = $table;
90 if ( $table =~ /^(.*)s$/ ) {
91 $tablemap{$1} = $table;
95 $tablemap{'CreatedBy'} = 'User';
96 $tablemap{'UpdatedBy'} = 'User';
98 $typemap{'id'} = 'ro';
99 $typemap{'Creator'} = 'auto';
100 $typemap{'Created'} = 'auto';
101 $typemap{'Updated'} = 'auto';
102 $typemap{'UpdatedBy'} = 'auto';
103 $typemap{'LastUpdated'} = 'auto';
104 $typemap{'LastUpdatedBy'} = 'auto';
106 foreach my $table (@tables) {
107 next if ($table eq 'sessions');
108 my $tablesingle = $table;
109 $tablesingle =~ s/s$//;
110 my $tableplural = $tablesingle . "s";
112 if ( $tablesingle eq 'ACL' ) {
113 $tablesingle = "ACE";
114 $tableplural = "ACL";
119 my $CollectionClassName = $namespace . "::" . $tableplural;
120 my $RecordClassName = $namespace . "::" . $tablesingle;
122 my $path = $namespace;
125 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
126 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
128 #create a collection class
131 my $ClassAccessible = "";
135 my $sth = $dbh->prepare("DESCRIBE $table");
138 while ( my $row = $sth->fetchrow_hashref() ) {
139 my $field = $row->{'Field'};
140 my $type = $row->{'Type'};
141 my $default = $row->{'Default'};
144 #generate the 'accessible' datastructure
146 if ( $typemap{$field} eq 'auto' ) {
147 $ClassAccessible .= " $field =>
148 {read => 1, auto => 1,";
150 elsif ( $typemap{$field} eq 'ro' ) {
151 $ClassAccessible .= " $field =>
155 $ClassAccessible .= " $field =>
156 {read => 1, write => 1,";
160 $ClassAccessible .= " type => '$type', default => '$default'},\n";
162 #generate pod for the accessible fields
166 Returns the current value of $field.
167 (In the database, $field is stored as $type.)
171 unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
174 =head2 Set$field VALUE
178 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
179 (In the database, $field will be stored as a $type.)
189 if ( $modulemap{$field} ) {
193 Returns the $modulemap{$field} Object which has the id returned by $field
200 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
201 \$$field->Load(\$self->__Value('$field'));
205 $requirements{ $tablemap{$field} } =
206 "use ${namespace}::$modulemap{$field};";
210 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
212 #generate create statement
213 $CreateInParams .= " $field => '$default',\n";
215 " $field => \$args{'$field'},\n";
217 #gerenate pod for the create statement
218 $CreatePod .= " $type '$field'";
219 $CreatePod .= " defaults to '$default'" if ($default);
232 \$self->SUPER::Create(
237 $CreatePod .= "\n=cut\n\n";
239 my $CollectionClass = $LicenseBlock . $Attribution .
245 $CollectionClassName -- Class Description
249 use $CollectionClassName
258 package $CollectionClassName;
260 use $CollectionBaseclass;
261 use $RecordClassName;
263 use vars qw( \@ISA );
264 \@ISA= qw($CollectionBaseclass);
269 \$self->{'table'} = '$table';
270 \$self->{'primary_key'} = 'id';
274 if ( $fields{'SortOrder'} ) {
276 $CollectionClass .= "
278 # By default, order by name
279 \$self->OrderBy( ALIAS => 'main',
280 FIELD => 'SortOrder',
284 $CollectionClass .= "
285 return ( \$self->SUPER::_Init(\@_) );
291 Returns an empty new $RecordClassName item
297 return($RecordClassName->new(\$self->CurrentUser));
299 " . MagicImport($CollectionClassName);
301 my $RecordClassHeader = $Attribution . "
316 package $RecordClassName;
317 use $RecordBaseclass;
320 foreach my $key ( keys %requirements ) {
321 $RecordClassHeader .= $requirements{$key} . "\n";
323 $RecordClassHeader .= "
325 use vars qw( \@ISA );
326 \@ISA= qw( $RecordBaseclass );
331 \$self->Table('$table');
332 \$self->SUPER::_Init(\@_);
337 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
341 =head2 Create PARAMHASH
343 Create takes a hash of values and creates a row in the database:
351 sub _ClassAccessible {
358 " . MagicImport($RecordClassName);
360 print "About to make $RecordClassPath, $CollectionClassPath\n";
363 open( RECORD, ">$RecordClassPath" );
364 print RECORD $RecordClass;
367 open( COL, ">$CollectionClassPath" );
368 print COL $CollectionClass;
376 #if (exists \$warnings::{unimport}) {
377 # no warnings qw(redefine);
384 eval \"require @{[$class]}_Overlay\";
385 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
389 eval \"require @{[$class]}_Vendor\";
390 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
394 eval \"require @{[$class]}_Local\";
395 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
404 This class allows \"overlay\" methods to be placed
405 into the following files _Overlay is for a System overlay by the original author,
406 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
408 These overlay files can contain new subs or subs to replace existing subs in this module.
410 If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
412 no warnings qw(redefine);
414 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
416 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local