2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2013 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 }}}
53 die "Usage: $0 database namespace" if @ARGV != 2;
56 my $namespace = shift;
58 my $CollectionBaseclass = 'RT::SearchBuilder';
59 my $RecordBaseclass = 'RT::Record';
62 my $hostname = 'localhost';
67 my $LicenseBlock = '';
70 my $dsn = "DBI:$driver:database=$database;host=$hostname";
72 my $dbh = DBI->connect( $dsn, $user, $password );
74 #get all tables out of database
75 my @tables = map { s/^\`\Q$database\E\`\.//; $_ } $dbh->tables();
77 my ( %tablemap, $typemap, %modulemap );
79 foreach my $table (@tables) {
81 next if ($table eq 'sessions');
82 $table = ucfirst($table);
83 $table =~ s/field/Field/;
84 $table =~ s/group/Group/;
85 $table =~ s/custom/Custom/;
86 $table =~ s/member/Member/;
87 $table =~ s/Scripaction/ScripAction/g;
88 $table =~ s/condition/Condition/g;
89 $table =~ s/value/Value/;
90 $table =~ s/Acl/ACL/g;
91 $tablemap{$table} = $table;
92 $modulemap{$table} = $table;
93 if ( $table =~ /^(.*)s$/ ) {
94 $tablemap{$1} = $table;
98 $tablemap{'CreatedBy'} = 'User';
99 $tablemap{'UpdatedBy'} = 'User';
102 $typemap{'id'} = 'ro';
103 $typemap{'Creator'} = 'auto';
104 $typemap{'Created'} = 'auto';
105 $typemap{'Updated'} = 'auto';
106 $typemap{'UpdatedBy'} = 'auto';
107 $typemap{'LastUpdated'} = 'auto';
108 $typemap{'LastUpdatedBy'} = 'auto';
110 foreach my $table (@tables) {
111 next if ($table eq 'sessions');
112 my $tablesingle = $table;
113 $tablesingle =~ s/s$//;
114 my $tableplural = $tablesingle . "s";
116 if ( $tablesingle eq 'ACL' ) {
117 $tablesingle = "ACE";
118 $tableplural = "ACL";
123 my $CollectionClassName = $namespace . "::" . $tableplural;
124 my $RecordClassName = $namespace . "::" . $tablesingle;
126 my $path = $namespace;
129 my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
130 my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
132 #create a collection class
135 my $ClassAccessible = "";
142 my $introspection = $dbh->prepare("SELECT * from $table where id is null");
143 $introspection->execute();
144 my @names =@{ $introspection->{'NAME'}};
145 my @types = @{$introspection->{'TYPE'}};
146 my @is_blob = @{$introspection->{'mysql_is_blob'}};
147 my @is_num = @{$introspection->{'mysql_is_num'}};
152 foreach my $name (@names) {
153 $sqltypes{$name} = shift @types;
154 $blobness{$name} = (shift @is_blob || "0");
155 $numeric{$name} = (shift @is_num || "0");
159 my $sth = $dbh->prepare("DESCRIBE $table");
162 while ( my $row = $sth->fetchrow_hashref() ) {
163 my $field = $row->{'Field'};
164 my $type = $row->{'Type'};
165 my $default = $row->{'Default'};
167 if ($type =~ /^(?:.*?)\((\d+)\)$/) {
172 #generate the 'accessible' datastructure
174 no warnings 'uninitialized';
176 if ( $typemap{$field} eq 'auto' ) {
177 $ClassAccessible .= " $field =>
178 {read => 1, auto => 1,";
180 elsif ( $typemap{$field} eq 'ro' ) {
181 $ClassAccessible .= " $field =>
185 $ClassAccessible .= " $field =>
186 {read => 1, write => 1,";
189 $ClassAccessible .= " sql_type => $sqltypes{$field}, length => $length, is_blob => $blobness{$field}, is_numeric => $numeric{$field}, ";
190 $ClassAccessible .= " type => '$type', default => '$default'},\n";
192 #generate pod for the accessible fields
196 Returns the current value of $field.
197 (In the database, $field is stored as $type.)
201 unless ( exists $typemap{$field} && ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' )) {
204 =head2 Set$field VALUE
208 Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
209 (In the database, $field will be stored as a $type.)
219 if ( $modulemap{$field} ) {
223 Returns the $modulemap{$field} Object which has the id returned by $field
230 my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
231 \$$field->Load(\$self->__Value('$field'));
235 $requirements{ $tablemap{$field} } =
236 "use ${namespace}::$modulemap{$field};";
240 unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
242 #generate create statement
243 $CreateInParams .= " $field => '$default',\n";
245 " $field => \$args{'$field'},\n";
247 #gerenate pod for the create statement
248 $CreatePod .= " $type '$field'";
249 $CreatePod .= " defaults to '$default'" if ($default);
257 $CreatePod .= "\n=cut\n\n";
259 my $CollectionClass = $LicenseBlock . $Attribution .
262 use $RecordClassName;
264 use base '$CollectionBaseclass';
266 sub Table { '$table'}
271 if ( $fields{'SortOrder'} && $fields{'Name'} ) {
272 $CollectionClass .= "
274 # By default, order by SortOrder
277 FIELD => 'SortOrder',
288 elsif ( $fields{'SortOrder'} ) {
290 $CollectionClass .= "
292 # By default, order by SortOrder
295 FIELD => 'SortOrder',
303 $CollectionClass .= "
304 return ( \$self->SUPER::_Init(\@_) );
310 Returns an empty new $RecordClassName item
316 return($RecordClassName->new(\$self->CurrentUser));
318 " . MagicImport($CollectionClassName);
320 my $RecordClassHeader = $Attribution . "
323 foreach my $key ( keys %requirements ) {
324 $RecordClassHeader .= $requirements{$key} . "\n";
326 $RecordClassHeader .= "use base '$RecordBaseclass';
332 my $RecordClass = $LicenseBlock . $RecordClassHeader . "
338 sub _CoreAccessible {
345 " . MagicImport($RecordClassName);
347 print "About to make $RecordClassPath, $CollectionClassPath\n";
350 open( RECORD, '>>', $RecordClassPath ) or die $!;
351 print RECORD $RecordClass;
354 open( COL, '>>', $CollectionClassPath ) or die $!;
355 print COL $CollectionClass;
363 #if (exists \$warnings::{unimport}) {
364 # no warnings qw(redefine);
366 my $content = "RT::Base->_ImportOverlays();