2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2007 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., 51 Franklin Street, Fifth Floor, Boston, MA
27 # 02110-1301 or visit their web page on the internet at
28 # http://www.gnu.org/copyleft/gpl.html.
31 # CONTRIBUTION SUBMISSION POLICY:
33 # (The following paragraph is not intended to limit the rights granted
34 # to you to modify and distribute this software under the terms of
35 # the GNU General Public License and is only of importance to you if
36 # you choose to contribute your changes and enhancements to the
37 # community by submitting them to Best Practical Solutions, LLC.)
39 # By intentionally submitting any modifications, corrections or
40 # derivatives to this work, or any other work intended for use with
41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
42 # you are the copyright holder for those contributions and you grant
43 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
44 # royalty-free, perpetual, license to use, copy, create derivative
45 # works based on those contributions, and sublicense and distribute
46 # those contributions and any derivatives thereof.
48 # END BPS TAGGED BLOCK }}}
53 my $namespace = shift;
55 my $CollectionBaseclass = 'RT::SearchBuilder';
56 my $RecordBaseclass = 'RT::Record';
59 my $hostname = 'localhost';
64 my $LicenseBlock = << '.';
65 # BEGIN BPS TAGGED BLOCK {{{
69 # This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC
70 # <jesse@bestpractical.com>
72 # (Except where explicitly superseded by other copyright notices)
77 # This work is made available to you under the terms of Version 2 of
78 # the GNU General Public License. A copy of that license should have
79 # been provided with this software, but in any event can be snarfed
82 # This work is distributed in the hope that it will be useful, but
83 # WITHOUT ANY WARRANTY; without even the implied warranty of
84 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
85 # General Public License for more details.
87 # You should have received a copy of the GNU General Public License
88 # along with this program; if not, write to the Free Software
89 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
92 # CONTRIBUTION SUBMISSION POLICY:
94 # (The following paragraph is not intended to limit the rights granted
95 # to you to modify and distribute this software under the terms of
96 # the GNU General Public License and is only of importance to you if
97 # you choose to contribute your changes and enhancements to the
98 # community by submitting them to Best Practical Solutions, LLC.)
100 # By intentionally submitting any modifications, corrections or
101 # derivatives to this work, or any other work intended for use with
102 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
103 # you are the copyright holder for those contributions and you grant
104 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
105 # royalty-free, perpetual, license to use, copy, create derivative
106 # works based on those contributions, and sublicense and distribute
107 # those contributions and any derivatives thereof.
109 # END BPS TAGGED BLOCK }}}
112 my $Attribution = << '.';
113 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
114 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
116 # !! DO NOT EDIT THIS FILE !!
122 my $dsn = "DBI:$driver:database=$database;host=$hostname";
124 my $dbh = DBI->connect( $dsn, $user, $password );
126 #get all tables out of database
127 my @tables = $dbh->tables();
129 my ( %tablemap, $typemap, %modulemap );
131 foreach my $table (@tables) {
133 next if ($table eq 'sessions');
134 $table = ucfirst($table);
135 $table =~ s/field/Field/;
136 $table =~ s/group/Group/;
137 $table =~ s/custom/Custom/;
138 $table =~ s/member/Member/;
139 $table =~ s/Scripaction/ScripAction/g;
140 $table =~ s/condition/Condition/g;
141 $table =~ s/value/Value/;
142 $table =~ s/Acl/ACL/g;
143 $tablemap{$table} = $table;
144 $modulemap{$table} = $table;
145 if ( $table =~ /^(.*)s$/ ) {
146 $tablemap{$1} = $table;
150 $tablemap{'CreatedBy'} = 'User';
151 $tablemap{'UpdatedBy'} = 'User';
154 $typemap{'id'} = 'ro';
155 $typemap{'Creator'} = 'auto';
156 $typemap{'Created'} = 'auto';
157 $typemap{'Updated'} = 'auto';
158 $typemap{'UpdatedBy'} = 'auto';
159 $typemap{'LastUpdated'} = 'auto';
160 $typemap{'LastUpdatedBy'} = 'auto';
162 foreach my $table (@tables) {
163 next if ($table eq 'sessions');
164 my $tablesingle = $table;
165 $tablesingle =~ s/s$//;
166 my $tableplural = $tablesingle . "s";
168 if ( $tablesingle eq 'ACL' ) {
169 $tablesingle = "ACE";
170 $tableplural = "ACL";
175 my $CollectionClassName = $namespace . "::" . $tableplural;
176 my $RecordClassName = $namespace . "::" . $tablesingle;
178 my $path = $namespace;
181 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
182 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
184 #create a collection class
187 my $ClassAccessible = "";
194 my $introspection = $dbh->prepare("SELECT * from $table where id is null");
195 $introspection->execute();
196 my @names =@{ $introspection->{'NAME'}};
197 my @types = @{$introspection->{'TYPE'}};
198 my @is_blob = @{$introspection->{'mysql_is_blob'}};
199 my @is_num = @{$introspection->{'mysql_is_num'}};
204 foreach my $name (@names) {
205 $sqltypes{$name} = shift @types;
206 $blobness{$name} = (shift @is_blob || "0");
207 $numeric{$name} = (shift @is_num || "0");
211 my $sth = $dbh->prepare("DESCRIBE $table");
214 while ( my $row = $sth->fetchrow_hashref() ) {
215 my $field = $row->{'Field'};
216 my $type = $row->{'Type'};
217 my $default = $row->{'Default'};
219 if ($type =~ /^(?:.*?)\((\d+)\)$/) {
224 #generate the 'accessible' datastructure
226 no warnings 'uninitialized';
228 if ( $typemap{$field} eq 'auto' ) {
229 $ClassAccessible .= " $field =>
230 {read => 1, auto => 1,";
232 elsif ( $typemap{$field} eq 'ro' ) {
233 $ClassAccessible .= " $field =>
237 $ClassAccessible .= " $field =>
238 {read => 1, write => 1,";
241 $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
242 $ClassAccessible .= " type => '$type', default => '$default'},\n";
244 #generate pod for the accessible fields
248 Returns the current value of $field.
249 (In the database, $field is stored as $type.)
253 unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
256 =head2 Set$field VALUE
260 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
261 (In the database, $field will be stored as a $type.)
271 if ( $modulemap{$field} ) {
275 Returns the $modulemap{$field} Object which has the id returned by $field
282 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
283 \$$field->Load(\$self->__Value('$field'));
287 $requirements{ $tablemap{$field} } =
288 "use ${namespace}::$modulemap{$field};";
292 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
294 #generate create statement
295 $CreateInParams .= " $field => '$default',\n";
297 " $field => \$args{'$field'},\n";
299 #gerenate pod for the create statement
300 $CreatePod .= " $type '$field'";
301 $CreatePod .= " defaults to '$default'" if ($default);
314 \$self->SUPER::Create(
319 $CreatePod .= "\n=cut\n\n";
321 my $CollectionClass = $LicenseBlock . $Attribution .
327 $CollectionClassName -- Class Description
331 use $CollectionClassName
340 package $CollectionClassName;
342 use $CollectionBaseclass;
343 use $RecordClassName;
345 use vars qw( \@ISA );
346 \@ISA= qw($CollectionBaseclass);
351 \$self->{'table'} = '$table';
352 \$self->{'primary_key'} = 'id';
356 if ( $fields{'SortOrder'} ) {
358 $CollectionClass .= "
360 # By default, order by SortOrder
363 FIELD => 'SortOrder',
371 $CollectionClass .= "
372 return ( \$self->SUPER::_Init(\@_) );
378 Returns an empty new $RecordClassName item
384 return($RecordClassName->new(\$self->CurrentUser));
386 " . MagicImport($CollectionClassName);
388 my $RecordClassHeader = $Attribution . "
403 package $RecordClassName;
404 use $RecordBaseclass;
407 foreach my $key ( keys %requirements ) {
408 $RecordClassHeader .= $requirements{$key} . "\n";
410 $RecordClassHeader .= "
412 use vars qw( \@ISA );
413 \@ISA= qw( $RecordBaseclass );
418 \$self->Table('$table');
419 \$self->SUPER::_Init(\@_);
424 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
428 =head2 Create PARAMHASH
430 Create takes a hash of values and creates a row in the database:
438 sub _CoreAccessible {
445 " . MagicImport($RecordClassName);
447 print "About to make $RecordClassPath, $CollectionClassPath\n";
450 open( RECORD, ">$RecordClassPath" );
451 print RECORD $RecordClass;
454 open( COL, ">$CollectionClassPath" );
455 print COL $CollectionClass;
463 #if (exists \$warnings::{unimport}) {
464 # no warnings qw(redefine);
471 eval \"require @{[$class]}_Overlay\";
472 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
476 eval \"require @{[$class]}_Vendor\";
477 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
481 eval \"require @{[$class]}_Local\";
482 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
491 This class allows \"overlay\" methods to be placed
492 into the following files _Overlay is for a System overlay by the original author,
493 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
495 These overlay files can contain new subs or subs to replace existing subs in this module.
497 Each of these files should begin with the line
499 no warnings qw(redefine);
501 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
503 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local