2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2005 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 }}}
51 my $namespace = shift;
53 my $CollectionBaseclass = 'RT::SearchBuilder';
54 my $RecordBaseclass = 'RT::Record';
57 my $hostname = 'localhost';
62 my $LicenseBlock = << '.';
63 # BEGIN BPS TAGGED BLOCK {{{
67 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
68 # <jesse@bestpractical.com>
70 # (Except where explicitly superseded by other copyright notices)
75 # This work is made available to you under the terms of Version 2 of
76 # the GNU General Public License. A copy of that license should have
77 # been provided with this software, but in any event can be snarfed
80 # This work is distributed in the hope that it will be useful, but
81 # WITHOUT ANY WARRANTY; without even the implied warranty of
82 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
83 # General Public License for more details.
85 # You should have received a copy of the GNU General Public License
86 # along with this program; if not, write to the Free Software
87 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
90 # CONTRIBUTION SUBMISSION POLICY:
92 # (The following paragraph is not intended to limit the rights granted
93 # to you to modify and distribute this software under the terms of
94 # the GNU General Public License and is only of importance to you if
95 # you choose to contribute your changes and enhancements to the
96 # community by submitting them to Best Practical Solutions, LLC.)
98 # By intentionally submitting any modifications, corrections or
99 # derivatives to this work, or any other work intended for use with
100 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
101 # you are the copyright holder for those contributions and you grant
102 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
103 # royalty-free, perpetual, license to use, copy, create derivative
104 # works based on those contributions, and sublicense and distribute
105 # those contributions and any derivatives thereof.
107 # END BPS TAGGED BLOCK }}}
110 my $Attribution = << '.';
111 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
112 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
114 # !! DO NOT EDIT THIS FILE !!
120 my $dsn = "DBI:$driver:database=$database;host=$hostname";
122 my $dbh = DBI->connect( $dsn, $user, $password );
124 #get all tables out of database
125 my @tables = $dbh->tables();
127 my ( %tablemap, $typemap, %modulemap );
129 foreach my $table (@tables) {
131 next if ($table eq 'sessions');
132 $table = ucfirst($table);
133 $table =~ s/field/Field/;
134 $table =~ s/group/Group/;
135 $table =~ s/custom/Custom/;
136 $table =~ s/member/Member/;
137 $table =~ s/Scripaction/ScripAction/g;
138 $table =~ s/condition/Condition/g;
139 $table =~ s/value/Value/;
140 $table =~ s/Acl/ACL/g;
141 $tablemap{$table} = $table;
142 $modulemap{$table} = $table;
143 if ( $table =~ /^(.*)s$/ ) {
144 $tablemap{$1} = $table;
148 $tablemap{'CreatedBy'} = 'User';
149 $tablemap{'UpdatedBy'} = 'User';
152 $typemap{'id'} = 'ro';
153 $typemap{'Creator'} = 'auto';
154 $typemap{'Created'} = 'auto';
155 $typemap{'Updated'} = 'auto';
156 $typemap{'UpdatedBy'} = 'auto';
157 $typemap{'LastUpdated'} = 'auto';
158 $typemap{'LastUpdatedBy'} = 'auto';
160 foreach my $table (@tables) {
161 next if ($table eq 'sessions');
162 my $tablesingle = $table;
163 $tablesingle =~ s/s$//;
164 my $tableplural = $tablesingle . "s";
166 if ( $tablesingle eq 'ACL' ) {
167 $tablesingle = "ACE";
168 $tableplural = "ACL";
173 my $CollectionClassName = $namespace . "::" . $tableplural;
174 my $RecordClassName = $namespace . "::" . $tablesingle;
176 my $path = $namespace;
179 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
180 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
182 #create a collection class
185 my $ClassAccessible = "";
192 my $introspection = $dbh->prepare("SELECT * from $table where id is null");
193 $introspection->execute();
194 my @names =@{ $introspection->{'NAME'}};
195 my @types = @{$introspection->{'TYPE'}};
196 my @is_blob = @{$introspection->{'mysql_is_blob'}};
197 my @is_num = @{$introspection->{'mysql_is_num'}};
202 foreach my $name (@names) {
203 $sqltypes{$name} = shift @types;
204 $blobness{$name} = (shift @is_blob || "0");
205 $numeric{$name} = (shift @is_num || "0");
209 my $sth = $dbh->prepare("DESCRIBE $table");
212 while ( my $row = $sth->fetchrow_hashref() ) {
213 my $field = $row->{'Field'};
214 my $type = $row->{'Type'};
215 my $default = $row->{'Default'};
217 if ($type =~ /^(?:.*?)\((\d+)\)$/) {
222 #generate the 'accessible' datastructure
224 no warnings 'uninitialized';
226 if ( $typemap{$field} eq 'auto' ) {
227 $ClassAccessible .= " $field =>
228 {read => 1, auto => 1,";
230 elsif ( $typemap{$field} eq 'ro' ) {
231 $ClassAccessible .= " $field =>
235 $ClassAccessible .= " $field =>
236 {read => 1, write => 1,";
239 $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
240 $ClassAccessible .= " type => '$type', default => '$default'},\n";
242 #generate pod for the accessible fields
246 Returns the current value of $field.
247 (In the database, $field is stored as $type.)
251 unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
254 =head2 Set$field VALUE
258 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
259 (In the database, $field will be stored as a $type.)
269 if ( $modulemap{$field} ) {
273 Returns the $modulemap{$field} Object which has the id returned by $field
280 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
281 \$$field->Load(\$self->__Value('$field'));
285 $requirements{ $tablemap{$field} } =
286 "use ${namespace}::$modulemap{$field};";
290 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
292 #generate create statement
293 $CreateInParams .= " $field => '$default',\n";
295 " $field => \$args{'$field'},\n";
297 #gerenate pod for the create statement
298 $CreatePod .= " $type '$field'";
299 $CreatePod .= " defaults to '$default'" if ($default);
312 \$self->SUPER::Create(
317 $CreatePod .= "\n=cut\n\n";
319 my $CollectionClass = $LicenseBlock . $Attribution .
325 $CollectionClassName -- Class Description
329 use $CollectionClassName
338 package $CollectionClassName;
340 use $CollectionBaseclass;
341 use $RecordClassName;
343 use vars qw( \@ISA );
344 \@ISA= qw($CollectionBaseclass);
349 \$self->{'table'} = '$table';
350 \$self->{'primary_key'} = 'id';
354 if ( $fields{'SortOrder'} ) {
356 $CollectionClass .= "
358 # By default, order by SortOrder
361 FIELD => 'SortOrder',
369 $CollectionClass .= "
370 return ( \$self->SUPER::_Init(\@_) );
376 Returns an empty new $RecordClassName item
382 return($RecordClassName->new(\$self->CurrentUser));
384 " . MagicImport($CollectionClassName);
386 my $RecordClassHeader = $Attribution . "
401 package $RecordClassName;
402 use $RecordBaseclass;
405 foreach my $key ( keys %requirements ) {
406 $RecordClassHeader .= $requirements{$key} . "\n";
408 $RecordClassHeader .= "
410 use vars qw( \@ISA );
411 \@ISA= qw( $RecordBaseclass );
416 \$self->Table('$table');
417 \$self->SUPER::_Init(\@_);
422 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
426 =head2 Create PARAMHASH
428 Create takes a hash of values and creates a row in the database:
436 sub _CoreAccessible {
443 " . MagicImport($RecordClassName);
445 print "About to make $RecordClassPath, $CollectionClassPath\n";
448 open( RECORD, ">$RecordClassPath" );
449 print RECORD $RecordClass;
452 open( COL, ">$CollectionClassPath" );
453 print COL $CollectionClass;
461 #if (exists \$warnings::{unimport}) {
462 # no warnings qw(redefine);
469 eval \"require @{[$class]}_Overlay\";
470 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
474 eval \"require @{[$class]}_Vendor\";
475 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
479 eval \"require @{[$class]}_Local\";
480 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
489 This class allows \"overlay\" methods to be placed
490 into the following files _Overlay is for a System overlay by the original author,
491 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
493 These overlay files can contain new subs or subs to replace existing subs in this module.
495 Each of these files should begin with the line
497 no warnings qw(redefine);
499 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
501 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local