2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
7 # <sales@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 = '';
69 my $dsn = "DBI:$driver:database=$database;host=$hostname";
71 my $dbh = DBI->connect( $dsn, $user, $password );
73 #get all tables out of database
74 my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
76 my ( %tablemap, $typemap, %modulemap );
78 foreach my $table (@tables) {
80 next if ($table eq 'sessions');
81 $table = ucfirst($table);
82 $table =~ s/field/Field/;
83 $table =~ s/group/Group/;
84 $table =~ s/custom/Custom/;
85 $table =~ s/member/Member/;
86 $table =~ s/Scripaction/ScripAction/g;
87 $table =~ s/condition/Condition/g;
88 $table =~ s/value/Value/;
89 $table =~ s/Acl/ACL/g;
90 $tablemap{$table} = $table;
91 $modulemap{$table} = $table;
92 if ( $table =~ /^(.*)s$/ ) {
93 $tablemap{$1} = $table;
97 $tablemap{'CreatedBy'} = 'User';
98 $tablemap{'UpdatedBy'} = 'User';
101 $typemap{'id'} = 'ro';
102 $typemap{'Creator'} = 'auto';
103 $typemap{'Created'} = 'auto';
104 $typemap{'Updated'} = 'auto';
105 $typemap{'UpdatedBy'} = 'auto';
106 $typemap{'LastUpdated'} = 'auto';
107 $typemap{'LastUpdatedBy'} = 'auto';
109 foreach my $table (@tables) {
110 next if ($table eq 'sessions');
111 my $tablesingle = $table;
112 $tablesingle =~ s/s$//;
113 my $tableplural = $tablesingle . "s";
115 if ( $tablesingle eq 'ACL' ) {
116 $tablesingle = "ACE";
117 $tableplural = "ACL";
122 my $CollectionClassName = $namespace . "::" . $tableplural;
123 my $RecordClassName = $namespace . "::" . $tablesingle;
125 my $path = $namespace;
128 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
129 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
131 #create a collection class
134 my $ClassAccessible = "";
141 my $introspection = $dbh->prepare("SELECT * from $table where id is null");
142 $introspection->execute();
143 my @names =@{ $introspection->{'NAME'}};
144 my @types = @{$introspection->{'TYPE'}};
145 my @is_blob = @{$introspection->{'mysql_is_blob'}};
146 my @is_num = @{$introspection->{'mysql_is_num'}};
151 foreach my $name (@names) {
152 $sqltypes{$name} = shift @types;
153 $blobness{$name} = (shift @is_blob || "0");
154 $numeric{$name} = (shift @is_num || "0");
158 my $sth = $dbh->prepare("DESCRIBE $table");
161 while ( my $row = $sth->fetchrow_hashref() ) {
162 my $field = $row->{'Field'};
163 my $type = $row->{'Type'};
164 my $default = $row->{'Default'};
166 if ($type =~ /^(?:.*?)\((\d+)\)$/) {
171 #generate the 'accessible' datastructure
173 no warnings 'uninitialized';
175 if ( $typemap{$field} eq 'auto' ) {
176 $ClassAccessible .= " $field =>
177 {read => 1, auto => 1,";
179 elsif ( $typemap{$field} eq 'ro' ) {
180 $ClassAccessible .= " $field =>
184 $ClassAccessible .= " $field =>
185 {read => 1, write => 1,";
188 $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
189 $ClassAccessible .= " type => '$type', default => '$default'},\n";
191 #generate pod for the accessible fields
195 Returns the current value of $field.
196 (In the database, $field is stored as $type.)
200 unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
203 =head2 Set$field VALUE
207 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
208 (In the database, $field will be stored as a $type.)
218 if ( $modulemap{$field} ) {
222 Returns the $modulemap{$field} Object which has the id returned by $field
229 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
230 \$$field->Load(\$self->__Value('$field'));
234 $requirements{ $tablemap{$field} } =
235 "use ${namespace}::$modulemap{$field};";
239 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
241 #generate create statement
242 $CreateInParams .= " $field => '$default',\n";
244 " $field => \$args{'$field'},\n";
246 #gerenate pod for the create statement
247 $CreatePod .= " $type '$field'";
248 $CreatePod .= " defaults to '$default'" if ($default);
256 $CreatePod .= "\n=cut\n\n";
258 my $CollectionClass = $LicenseBlock . $Attribution .
261 use $RecordClassName;
263 use base '$CollectionBaseclass';
265 sub Table { '$table'}
270 if ( $fields{'SortOrder'} && $fields{'Name'} ) {
271 $CollectionClass .= "
273 # By default, order by SortOrder
276 FIELD => 'SortOrder',
287 elsif ( $fields{'SortOrder'} ) {
289 $CollectionClass .= "
291 # By default, order by SortOrder
294 FIELD => 'SortOrder',
302 $CollectionClass .= "
303 return ( \$self->SUPER::_Init(\@_) );
309 Returns an empty new $RecordClassName item
315 return($RecordClassName->new(\$self->CurrentUser));
317 " . MagicImport($CollectionClassName);
319 my $RecordClassHeader = $Attribution . "
322 foreach my $key ( keys %requirements ) {
323 $RecordClassHeader .= $requirements{$key} . "\n";
325 $RecordClassHeader .= "use base '$RecordBaseclass';
331 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
337 sub _CoreAccessible {
344 " . MagicImport($RecordClassName);
346 print "About to make $RecordClassPath, $CollectionClassPath\n";
349 open( RECORD, '>>', $RecordClassPath ) or die $!;
350 print RECORD $RecordClass;
353 open( COL, '>>', $CollectionClassPath ) or die $!;
354 print COL $CollectionClass;
362 #if (exists \$warnings::{unimport}) {
363 # no warnings qw(redefine);
365 my $content = "RT::Base->_ImportOverlays();