2 # {{{ BEGIN BPS TAGGED BLOCK
6 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
7 # <jesse@bestpractical.com>
9 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
29 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
46 # }}} END BPS TAGGED BLOCK
50 my $namespace = shift;
52 my $CollectionBaseclass = 'RT::SearchBuilder';
53 my $RecordBaseclass = 'RT::Record';
56 my $hostname = 'localhost';
61 my $LicenseBlock = << '.';
62 # BEGIN BPS TAGGED BLOCK
64 # Copyright (c) 1996-2003 Jesse Vincent <jesse@bestpractical.com>
66 # (Except where explictly superceded by other copyright notices)
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
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.
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.
84 # END BPS TAGGED BLOCK
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.
92 # !! DO NOT EDIT THIS FILE !!
98 my $dsn = "DBI:$driver:database=$database;host=$hostname";
100 my $dbh = DBI->connect( $dsn, $user, $password );
102 #get all tables out of database
103 my @tables = $dbh->tables();
105 my ( %tablemap, $typemap, %modulemap );
107 foreach my $table (@tables) {
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;
126 $tablemap{'CreatedBy'} = 'User';
127 $tablemap{'UpdatedBy'} = 'User';
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';
137 foreach my $table (@tables) {
138 next if ($table eq 'sessions');
139 my $tablesingle = $table;
140 $tablesingle =~ s/s$//;
141 my $tableplural = $tablesingle . "s";
143 if ( $tablesingle eq 'ACL' ) {
144 $tablesingle = "ACE";
145 $tableplural = "ACL";
150 my $CollectionClassName = $namespace . "::" . $tableplural;
151 my $RecordClassName = $namespace . "::" . $tablesingle;
153 my $path = $namespace;
156 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
157 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
159 #create a collection class
162 my $ClassAccessible = "";
166 my $sth = $dbh->prepare("DESCRIBE $table");
169 while ( my $row = $sth->fetchrow_hashref() ) {
170 my $field = $row->{'Field'};
171 my $type = $row->{'Type'};
172 my $default = $row->{'Default'};
175 #generate the 'accessible' datastructure
177 if ( $typemap{$field} eq 'auto' ) {
178 $ClassAccessible .= " $field =>
179 {read => 1, auto => 1,";
181 elsif ( $typemap{$field} eq 'ro' ) {
182 $ClassAccessible .= " $field =>
186 $ClassAccessible .= " $field =>
187 {read => 1, write => 1,";
191 $ClassAccessible .= " type => '$type', default => '$default'},\n";
193 #generate pod for the accessible fields
197 Returns the current value of $field.
198 (In the database, $field is stored as $type.)
202 unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
205 =head2 Set$field 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.)
220 if ( $modulemap{$field} ) {
224 Returns the $modulemap{$field} Object which has the id returned by $field
231 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
232 \$$field->Load(\$self->__Value('$field'));
236 $requirements{ $tablemap{$field} } =
237 "use ${namespace}::$modulemap{$field};";
241 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
243 #generate create statement
244 $CreateInParams .= " $field => '$default',\n";
246 " $field => \$args{'$field'},\n";
248 #gerenate pod for the create statement
249 $CreatePod .= " $type '$field'";
250 $CreatePod .= " defaults to '$default'" if ($default);
263 \$self->SUPER::Create(
268 $CreatePod .= "\n=cut\n\n";
270 my $CollectionClass = $LicenseBlock . $Attribution .
276 $CollectionClassName -- Class Description
280 use $CollectionClassName
289 package $CollectionClassName;
291 use $CollectionBaseclass;
292 use $RecordClassName;
294 use vars qw( \@ISA );
295 \@ISA= qw($CollectionBaseclass);
300 \$self->{'table'} = '$table';
301 \$self->{'primary_key'} = 'id';
305 if ( $fields{'SortOrder'} ) {
307 $CollectionClass .= "
309 # By default, order by name
310 \$self->OrderBy( ALIAS => 'main',
311 FIELD => 'SortOrder',
315 $CollectionClass .= "
316 return ( \$self->SUPER::_Init(\@_) );
322 Returns an empty new $RecordClassName item
328 return($RecordClassName->new(\$self->CurrentUser));
330 " . MagicImport($CollectionClassName);
332 my $RecordClassHeader = $Attribution . "
347 package $RecordClassName;
348 use $RecordBaseclass;
351 foreach my $key ( keys %requirements ) {
352 $RecordClassHeader .= $requirements{$key} . "\n";
354 $RecordClassHeader .= "
356 use vars qw( \@ISA );
357 \@ISA= qw( $RecordBaseclass );
362 \$self->Table('$table');
363 \$self->SUPER::_Init(\@_);
368 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
372 =head2 Create PARAMHASH
374 Create takes a hash of values and creates a row in the database:
382 sub _CoreAccessible {
389 " . MagicImport($RecordClassName);
391 print "About to make $RecordClassPath, $CollectionClassPath\n";
394 open( RECORD, ">$RecordClassPath" );
395 print RECORD $RecordClass;
398 open( COL, ">$CollectionClassPath" );
399 print COL $CollectionClass;
407 #if (exists \$warnings::{unimport}) {
408 # no warnings qw(redefine);
415 eval \"require @{[$class]}_Overlay\";
416 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
420 eval \"require @{[$class]}_Vendor\";
421 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
425 eval \"require @{[$class]}_Local\";
426 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
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.
439 These overlay files can contain new subs or subs to replace existing subs in this module.
441 If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
443 no warnings qw(redefine);
445 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
447 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local