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.
66 my $Attribution = << '.';
67 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
68 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
70 # !! DO NOT EDIT THIS FILE !!
76 my $dsn = "DBI:$driver:database=$database;host=$hostname";
78 my $dbh = DBI->connect( $dsn, $user, $password );
80 #get all tables out of database
81 my @tables = $dbh->tables();
83 my ( %tablemap, $typemap, %modulemap );
85 foreach my $table (@tables) {
86 next if ($table eq 'sessions');
87 $tablemap{$table} = $table;
88 $modulemap{$table} = $table;
89 if ( $table =~ /^(.*)s$/ ) {
90 $tablemap{$1} = $table;
94 $tablemap{'CreatedBy'} = 'User';
95 $tablemap{'UpdatedBy'} = 'User';
97 $typemap{'id'} = 'ro';
98 $typemap{'Creator'} = 'auto';
99 $typemap{'Created'} = 'auto';
100 $typemap{'Updated'} = 'auto';
101 $typemap{'UpdatedBy'} = 'auto';
102 $typemap{'LastUpdated'} = 'auto';
103 $typemap{'LastUpdatedBy'} = 'auto';
105 foreach my $table (@tables) {
106 next if ($table eq 'sessions');
107 my $tablesingle = $table;
108 $tablesingle =~ s/s$//;
109 my $tableplural = $tablesingle . "s";
111 if ( $tablesingle eq 'ACL' ) {
112 $tablesingle = "ACE";
113 $tableplural = "ACL";
118 my $CollectionClassName = $namespace . "::" . $tableplural;
119 my $RecordClassName = $namespace . "::" . $tablesingle;
121 my $path = $namespace;
124 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
125 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
127 #create a collection class
130 my $ClassAccessible = "";
134 my $sth = $dbh->prepare("DESCRIBE $table");
137 while ( my $row = $sth->fetchrow_hashref() ) {
138 my $field = $row->{'Field'};
139 my $type = $row->{'Type'};
140 my $default = $row->{'Default'};
143 #generate the 'accessible' datastructure
145 if ( $typemap{$field} eq 'auto' ) {
146 $ClassAccessible .= " $field =>
147 {read => 1, auto => 1,";
149 elsif ( $typemap{$field} eq 'ro' ) {
150 $ClassAccessible .= " $field =>
154 $ClassAccessible .= " $field =>
155 {read => 1, write => 1,";
159 $ClassAccessible .= " type => '$type', default => '$default'},\n";
161 #generate pod for the accessible fields
165 Returns the current value of $field.
166 (In the database, $field is stored as $type.)
170 unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
173 =head2 Set$field VALUE
177 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
178 (In the database, $field will be stored as a $type.)
188 if ( $modulemap{$field} ) {
192 Returns the $modulemap{$field} Object which has the id returned by $field
199 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
200 \$$field->Load(\$self->__Value('$field'));
204 $requirements{ $tablemap{$field} } =
205 "use ${namespace}::$modulemap{$field};";
209 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
211 #generate create statement
212 $CreateInParams .= " $field => '$default',\n";
214 " $field => \$args{'$field'},\n";
216 #gerenate pod for the create statement
217 $CreatePod .= " $type '$field'";
218 $CreatePod .= " defaults to '$default'" if ($default);
231 \$self->SUPER::Create(
236 $CreatePod .= "\n=cut\n\n";
238 my $CollectionClass = $LicenseBlock . $Attribution .
244 $CollectionClassName -- Class Description
248 use $CollectionClassName
257 package $CollectionClassName;
259 use $CollectionBaseclass;
260 use $RecordClassName;
262 use vars qw( \@ISA );
263 \@ISA= qw($CollectionBaseclass);
268 \$self->{'table'} = '$table';
269 \$self->{'primary_key'} = 'id';
273 if ( $fields{'SortOrder'} ) {
275 $CollectionClass .= "
277 # By default, order by name
278 \$self->OrderBy( ALIAS => 'main',
279 FIELD => 'SortOrder',
283 $CollectionClass .= "
284 return ( \$self->SUPER::_Init(\@_) );
290 Returns an empty new $RecordClassName item
296 return($RecordClassName->new(\$self->CurrentUser));
298 " . MagicImport($CollectionClassName);
300 my $RecordClassHeader = $Attribution . "
315 package $RecordClassName;
316 use $RecordBaseclass;
319 foreach my $key ( keys %requirements ) {
320 $RecordClassHeader .= $requirements{$key} . "\n";
322 $RecordClassHeader .= "
324 use vars qw( \@ISA );
325 \@ISA= qw( $RecordBaseclass );
330 \$self->Table('$table');
331 \$self->SUPER::_Init(\@_);
336 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
340 =head2 Create PARAMHASH
342 Create takes a hash of values and creates a row in the database:
350 sub _ClassAccessible {
357 " . MagicImport($RecordClassName);
359 print "About to make $RecordClassPath, $CollectionClassPath\n";
362 open( RECORD, ">$RecordClassPath" );
363 print RECORD $RecordClass;
366 open( COL, ">$CollectionClassPath" );
367 print COL $CollectionClass;
375 #if (exists \$warnings::{unimport}) {
376 # no warnings qw(redefine);
383 eval \"require @{[$class]}_Overlay\";
384 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
388 eval \"require @{[$class]}_Vendor\";
389 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
393 eval \"require @{[$class]}_Local\";
394 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
403 This class allows \"overlay\" methods to be placed
404 into the following files _Overlay is for a System overlay by the original author,
405 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
407 These overlay files can contain new subs or subs to replace existing subs in this module.
409 If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
411 no warnings qw(redefine);
413 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
415 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local