File Coverage

blib/lib/FabForce/DBDesigner4/XML.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package FabForce::DBDesigner4::XML;
2              
3             # ABSTRACT: parse XML file
4              
5 10     10   182 use 5.006001;
  10         26  
  10         440  
6 10     10   49 use strict;
  10         13  
  10         318  
7 10     10   41 use warnings;
  10         11  
  10         283  
8 10     10   11045 use XML::Twig;
  0            
  0            
9             use FabForce::DBDesigner4::Table qw(:const);
10              
11             our $VERSION = '0.3';
12              
13             sub new{
14             my ($class) = @_;
15             my $self = {};
16             bless $self,$class;
17            
18             $self->_reset_tables;
19             $self->_is_fabforce( 0 );
20             $self->_reset_columns;
21             $self->_reset_tableids;
22             $self->_reset_relationsid;
23            
24             return $self;
25             }# new
26              
27             sub parsefile{
28             my ($self,$filename) = @_;
29             return unless $filename;
30             $self->_reset_tables;
31             $self->_is_fabforce( 0 );
32             my $parser = XML::Twig->new(twig_handlers => {
33             'TABLE' => sub{_tables($self,@_)},
34             'COLUMN' => sub{_column($self,@_)},
35             'RELATION' => sub{_relation($self,@_)},
36             'INDEXCOLUMN' => sub{_index($self,@_)},
37             'DBMODEL' => sub{$self->_is_fabforce(1)},
38             });
39             $parser->parsefile($filename);
40             my $root = $parser->root;
41             return unless($self->_is_fabforce);
42            
43             for my $table( $self->_all_tables ){
44             $table->columns( $self->_table_columns( $table->name ) );
45             $table->column_details( $self->_table_column_details( $table->name ) );
46             $table->key( $self->_key( $table->name ) );
47             }
48              
49             return [ $self->_all_tables ];
50             }# parsefile
51              
52             sub _tables{
53             my ($self,$t,$table) = @_;
54            
55             my $name = $table->{att}->{Tablename};
56             my $xPos = $table->{att}->{XPos};
57             my $yPos = $table->{att}->{YPos};
58            
59             my $tableobj = FabForce::DBDesigner4::Table->new();
60             $tableobj->name($name);
61             $tableobj->coords([$xPos,$yPos,0,0]);
62            
63             $self->_add_table( $tableobj );
64             $self->_tableid( $table->{att}->{ID}, $name );
65             }# _tables
66              
67             sub _column{
68             my ($self,$t,$col) = @_;
69            
70             my $parent_table = $col->{parent}->{parent}->{att}->{Tablename};
71             my $name = $col->{att}->{ColName};
72             my $datatype = _datatypes('id2name',$col->{att}->{idDatatype});
73             my $typeAttr = $col->{att}->{DatatypeParams} ? $col->{att}->{DatatypeParams} : '';
74             my $notnull = $col->{att}->{NotNull} ? 'NOT NULL' : '';
75             my $default = $col->{att}->{DefaultValue};
76             my $autoinc = $col->{att}->{AutoInc} ? 'AUTOINCREMENT' : '';
77              
78             $col->{att}->{DataType} = $datatype;
79            
80             if( $datatype !~ m!INT! ){
81             $autoinc = "";
82             }
83            
84             if ( $typeAttr ) {
85             $typeAttr =~ s/\\a/'/g;
86             }
87              
88             $datatype .= $typeAttr;
89            
90             my $quotes = ( defined $default and $default =~ m!^\d+(?:\.\d*)?$! ) ?
91             "" : "'";
92            
93             my $info = '';
94             $info .= $notnull.' ' if $notnull;
95             $info .= sprintf "DEFAULT %s%s%s ", $quotes,$default,$quotes
96             if defined $default and $default ne '';
97             $info .= $autoinc if $autoinc;
98            
99             $info =~ s!\s+\z!!;
100            
101             $self->_add_columns( $parent_table, {$name => [$datatype,$info]} );
102             $self->_add_column_details( $parent_table, $col->{att} );
103             $self->_key( $parent_table, $name ) if $col->{att}->{PrimaryKey};
104             }# _column
105              
106             sub _relation{
107             my ($self,$t,$rel) = @_;
108            
109             my $src = $self->_tableid( $rel->{att}->{SrcTable} );
110             my @relations = split(/\\n/,$rel->{att}->{FKFields});
111             my ($obj) = grep{$_->name() eq $src}$self->_all_tables;
112             my $f_id = $self->_tableid( $rel->{att}->{DestTable} );
113             my ($f_table) = grep{$_->name() eq $f_id}$self->_all_tables;
114             my $type = $rel->{att}->{Kind};
115            
116             for my $relation(@relations){
117             my ($owncol,$foreign) = split(/=/,$relation,2);
118             $obj->addRelation( [ 1, $f_id.'.'.$foreign, $src.'.'.$owncol, $type ]);
119             $f_table->addRelation([ 1, $f_id.'.'.$foreign, $src.'.'.$owncol, $type ]);
120             }
121             }# _relation
122              
123             sub _index{
124             my ($self) = @_;
125             }# _index
126              
127             sub _is_fabforce{
128             my ($self,$value) = @_;
129             $self->{_ISFABFORCE_} = $value if defined $value;
130             return $self->{_ISFABFORCE_};
131             }
132              
133             sub _add_table{
134             my ($self,$table) = @_;
135             push @{ $self->{_TABLES_} }, $table;
136             }
137              
138             sub _reset_tables{
139             my ($self) = @_;
140             $self->{_TABLES_} = [];
141             }
142              
143             sub _all_tables{
144             my ($self) = @_;
145            
146             return @{ $self->{_TABLES_} };
147             }
148              
149             sub _reset_columns{
150             my ($self) = @_;
151             $self->{_COLUMNS_} = {};
152             }
153              
154             sub _table_columns{
155             my ($self,$name) = @_;
156             return $self->{_COLUMNS_}->{$name} if exists $self->{_COLUMNS_}->{$name};
157             return;
158             }
159              
160             sub _add_columns{
161             my ($self,$table,$value) = @_;
162             push @{ $self->{_COLUMNS_}->{$table} }, $value if defined $value;
163             }
164              
165             sub _table_column_details {
166             my ($self, $name) = @_;
167             return $self->{_COLUMN_DETAILS_}->{$name};
168             }
169              
170             sub _add_column_details {
171             my ($self, $table, $details) = @_;
172             push @{ $self->{_COLUMN_DETAILS_}->{$table} }, $details if defined $details;
173             }
174              
175             sub _reset_relationsid{
176             my ($self) = @_;
177             $self->{_RELATIONSID_} = {};
178             }
179              
180             sub _relationsid{
181             my ($self,$key,$value) = @_;
182             $self->{_RELATIONSID_}->{$key} = $value if defined $value;
183             return $self->{_RELATIONSID_}->{$key} if exists $self->{_RELATIONSID_}->{$key};
184             return;
185             }
186              
187             sub _reset_tableids{
188             my ($self) = @_;
189             $self->{_TABLEIDS_} = {};
190             }
191              
192             sub _tableid{
193             my ($self,$id,$value) = @_;
194             $self->{_TABLEIDS_}->{$id} = $value if defined $value;
195             return $self->{_TABLEIDS_}->{$id} if exists $self->{_TABLEIDS_}->{$id};
196             return;
197             }
198              
199             sub _key{
200             my ($self,$table,$value) = @_;
201             push @{ $self->{_KEYS_}->{$table} }, $value if defined $value;
202             return $self->{_KEYS_}->{$table} if exists $self->{_KEYS_}->{$table};
203             return;
204             }
205              
206             sub _printRelations{
207             my ($self,$struct) = @_;
208             return " ";
209             }# _printRelations
210              
211             sub _datatypes{
212             my ($type,$key) = @_;
213             $key = uc($key);
214             my %name2id = (
215             'TINYINT' => 1,
216             'SMALLINT' => 2,
217             'MEDIUMINT' => 3,
218             'INT' => 4,
219             'INTEGER' => 5,
220             'BIGINT' => 6,
221             'FLOAT' => 7,
222             'DOUBLE' => 9,
223             'DOUBLE PRECISION' => 10,
224             'REAL' => 11,
225             'DECIMAL' => 12,
226             'NUMERIC' => 13,
227             'DATE' => 14,
228             'DATETIME' => 15,
229             'TIMESTAMP' => 16,
230             'TIME' => 17,
231             'YEAR' => 18,
232             'CHAR' => 19,
233             'VARCHAR' => 20,
234             'BIT' => 21,
235             'BOOL' => 22,
236             'TINYBLOB' => 23,
237             'BLOB' => 24,
238             'MEDIUMBLOB' => 25,
239             'LONGBLOB' => 26,
240             'TINYTEXT' => 27,
241             'TEXT' => 28,
242             'MEDIUMTEXT' => 29,
243             'LONGTEXT' => 30,
244             'ENUM' => 31,
245             'SET' => 32,
246             'Varchar(20)' => 33,
247             'Varchar(45)' => 34,
248             'Varchar(255)' => 35,
249             'GEOMETRY' => 36,
250             'LINESTRING' => 38,
251             'POLYGON' => 39,
252             'MULTIPOINT' => 40,
253             'MULTILINESTRING' => 41,
254             'MULTIPOLYGON' => 42,
255             'GEOMETRYCOLLECTION' => 43,
256             );
257             my %id2name;
258             for( keys %name2id ){
259             $id2name{$name2id{$_}} = uc($_);
260             $name2id{uc($_)} = $name2id{$_};
261             $name2id{lc($_)} = $name2id{$_};
262             }
263            
264             my $value;
265             if($type eq 'name2id' && exists($name2id{$key})){
266             $value = $name2id{$key};
267             }
268             elsif($type eq 'id2name' && exists($id2name{$key})){
269             $value = $id2name{$key};
270             }
271             else{
272             $value = 35;
273             }
274            
275             return $value;
276             }# _datatypes
277              
278             1;
279             __END__