2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2009 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/licenses/old-licenses/gpl-2.0.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 }}}
52 die "Usage: $0 database namespace" if @ARGV != 2;
55 my $namespace = shift;
57 my $CollectionBaseclass = 'RT::SearchBuilder';
58 my $RecordBaseclass = 'RT::Record';
61 my $hostname = 'localhost';
66 my $LicenseBlock = << '.';
67 # BEGIN BPS TAGGED BLOCK {{{
71 # This software is Copyright (c) 1996-2008 Best Practical Solutions, LLC
72 # <jesse@bestpractical.com>
74 # (Except where explicitly superseded by other copyright notices)
79 # This work is made available to you under the terms of Version 2 of
80 # the GNU General Public License. A copy of that license should have
81 # been provided with this software, but in any event can be snarfed
84 # This work is distributed in the hope that it will be useful, but
85 # WITHOUT ANY WARRANTY; without even the implied warranty of
86 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
87 # General Public License for more details.
89 # You should have received a copy of the GNU General Public License
90 # along with this program; if not, write to the Free Software
91 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
92 # 02110-1301 or visit their web page on the internet at
93 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
96 # CONTRIBUTION SUBMISSION POLICY:
98 # (The following paragraph is not intended to limit the rights granted
99 # to you to modify and distribute this software under the terms of
100 # the GNU General Public License and is only of importance to you if
101 # you choose to contribute your changes and enhancements to the
102 # community by submitting them to Best Practical Solutions, LLC.)
104 # By intentionally submitting any modifications, corrections or
105 # derivatives to this work, or any other work intended for use with
106 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
107 # you are the copyright holder for those contributions and you grant
108 # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
109 # royalty-free, perpetual, license to use, copy, create derivative
110 # works based on those contributions, and sublicense and distribute
111 # those contributions and any derivatives thereof.
113 # END BPS TAGGED BLOCK }}}
116 my $Attribution = << '.';
118 # Autogenerated by DBIx::SearchBuilder factory (by <jesse@bestpractical.com>)
119 # WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
121 # !! DO NOT EDIT THIS FILE !!
127 my $dsn = "DBI:$driver:database=$database;host=$hostname";
129 my $dbh = DBI->connect( $dsn, $user, $password );
131 #get all tables out of database
132 my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
134 my ( %tablemap, $typemap, %modulemap );
136 foreach my $table (@tables) {
138 next if ($table eq 'sessions');
139 $table = ucfirst($table);
140 $table =~ s/field/Field/;
141 $table =~ s/group/Group/;
142 $table =~ s/custom/Custom/;
143 $table =~ s/member/Member/;
144 $table =~ s/Scripaction/ScripAction/g;
145 $table =~ s/condition/Condition/g;
146 $table =~ s/value/Value/;
147 $table =~ s/Acl/ACL/g;
148 $tablemap{$table} = $table;
149 $modulemap{$table} = $table;
150 if ( $table =~ /^(.*)s$/ ) {
151 $tablemap{$1} = $table;
155 $tablemap{'CreatedBy'} = 'User';
156 $tablemap{'UpdatedBy'} = 'User';
159 $typemap{'id'} = 'ro';
160 $typemap{'Creator'} = 'auto';
161 $typemap{'Created'} = 'auto';
162 $typemap{'Updated'} = 'auto';
163 $typemap{'UpdatedBy'} = 'auto';
164 $typemap{'LastUpdated'} = 'auto';
165 $typemap{'LastUpdatedBy'} = 'auto';
167 foreach my $table (@tables) {
168 next if ($table eq 'sessions');
169 my $tablesingle = $table;
170 $tablesingle =~ s/s$//;
171 my $tableplural = $tablesingle . "s";
173 if ( $tablesingle eq 'ACL' ) {
174 $tablesingle = "ACE";
175 $tableplural = "ACL";
180 my $CollectionClassName = $namespace . "::" . $tableplural;
181 my $RecordClassName = $namespace . "::" . $tablesingle;
183 my $path = $namespace;
186 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
187 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
189 #create a collection class
192 my $ClassAccessible = "";
199 my $introspection = $dbh->prepare("SELECT * from $table where id is null");
200 $introspection->execute();
201 my @names =@{ $introspection->{'NAME'}};
202 my @types = @{$introspection->{'TYPE'}};
203 my @is_blob = @{$introspection->{'mysql_is_blob'}};
204 my @is_num = @{$introspection->{'mysql_is_num'}};
209 foreach my $name (@names) {
210 $sqltypes{$name} = shift @types;
211 $blobness{$name} = (shift @is_blob || "0");
212 $numeric{$name} = (shift @is_num || "0");
216 my $sth = $dbh->prepare("DESCRIBE $table");
219 while ( my $row = $sth->fetchrow_hashref() ) {
220 my $field = $row->{'Field'};
221 my $type = $row->{'Type'};
222 my $default = $row->{'Default'};
224 if ($type =~ /^(?:.*?)\((\d+)\)$/) {
229 #generate the 'accessible' datastructure
231 no warnings 'uninitialized';
233 if ( $typemap{$field} eq 'auto' ) {
234 $ClassAccessible .= " $field =>
235 {read => 1, auto => 1,";
237 elsif ( $typemap{$field} eq 'ro' ) {
238 $ClassAccessible .= " $field =>
242 $ClassAccessible .= " $field =>
243 {read => 1, write => 1,";
246 $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
247 $ClassAccessible .= " type => '$type', default => '$default'},\n";
249 #generate pod for the accessible fields
253 Returns the current value of $field.
254 (In the database, $field is stored as $type.)
258 unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
261 =head2 Set$field VALUE
265 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
266 (In the database, $field will be stored as a $type.)
276 if ( $modulemap{$field} ) {
280 Returns the $modulemap{$field} Object which has the id returned by $field
287 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
288 \$$field->Load(\$self->__Value('$field'));
292 $requirements{ $tablemap{$field} } =
293 "use ${namespace}::$modulemap{$field};";
297 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
299 #generate create statement
300 $CreateInParams .= " $field => '$default',\n";
302 " $field => \$args{'$field'},\n";
304 #gerenate pod for the create statement
305 $CreatePod .= " $type '$field'";
306 $CreatePod .= " defaults to '$default'" if ($default);
319 \$self->SUPER::Create(
324 $CreatePod .= "\n=cut\n\n";
326 my $CollectionClass = $LicenseBlock . $Attribution .
332 $CollectionClassName -- Class Description
336 use $CollectionClassName
345 package $CollectionClassName;
347 use $CollectionBaseclass;
348 use $RecordClassName;
350 use vars qw( \@ISA );
351 \@ISA= qw($CollectionBaseclass);
356 \$self->{'table'} = '$table';
357 \$self->{'primary_key'} = 'id';
361 if ( $fields{'SortOrder'} ) {
363 $CollectionClass .= "
365 # By default, order by SortOrder
368 FIELD => 'SortOrder',
376 $CollectionClass .= "
377 return ( \$self->SUPER::_Init(\@_) );
383 Returns an empty new $RecordClassName item
389 return($RecordClassName->new(\$self->CurrentUser));
391 " . MagicImport($CollectionClassName);
393 my $RecordClassHeader = $Attribution . "
408 package $RecordClassName;
409 use $RecordBaseclass;
412 foreach my $key ( keys %requirements ) {
413 $RecordClassHeader .= $requirements{$key} . "\n";
415 $RecordClassHeader .= "
417 use vars qw( \@ISA );
418 \@ISA= qw( $RecordBaseclass );
423 \$self->Table('$table');
424 \$self->SUPER::_Init(\@_);
429 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
433 =head2 Create PARAMHASH
435 Create takes a hash of values and creates a row in the database:
443 sub _CoreAccessible {
450 " . MagicImport($RecordClassName);
452 print "About to make $RecordClassPath, $CollectionClassPath\n";
455 open( RECORD, ">$RecordClassPath" );
456 print RECORD $RecordClass;
459 open( COL, ">$CollectionClassPath" );
460 print COL $CollectionClass;
468 #if (exists \$warnings::{unimport}) {
469 # no warnings qw(redefine);
476 eval \"require @{[$class]}_Overlay\";
477 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Overlay.pm}) {
481 eval \"require @{[$class]}_Vendor\";
482 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Vendor.pm}) {
486 eval \"require @{[$class]}_Local\";
487 if (\$@ && \$@ !~ qr{^Can't locate ".$path."_Local.pm}) {
496 This class allows \"overlay\" methods to be placed
497 into the following files _Overlay is for a System overlay by the original author,
498 _Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
500 These overlay files can contain new subs or subs to replace existing subs in this module.
502 Each of these files should begin with the line
504 no warnings qw(redefine);
506 so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
508 @{[$class]}_Overlay, @{[$class]}_Vendor, @{[$class]}_Local