File: 300-parse-classes-many-to-many.t

package info (click to toggle)
libparse-dia-sql-perl 0.31-2
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, forky, sid, trixie
  • size: 924 kB
  • sloc: perl: 3,865; makefile: 2
file content (125 lines) | stat: -rw-r--r-- 3,352 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
#   $Id: 300-parse-classes-many-to-many.t,v 1.3 2011/02/15 20:15:54 aff Exp $

# NOTE: This files has all the tests crammed together as opposed to
# the others that are using TestERD.dia - consider doing it more
# consistently..

use warnings;
use strict;

use Data::Dumper;
use Test::More;
use File::Spec::Functions;
use lib catdir qw ( blib lib );

plan tests => 34;

use_ok ('Parse::Dia::SQL');

my $diasql =  Parse::Dia::SQL->new( file => catfile(qw(t data many_to_many.dia)), db => 'db2' );
isa_ok($diasql, q{Parse::Dia::SQL}, q{Expect a Parse::Dia::SQL object});

# parse and convert document
is($diasql->convert(), 1, q{Expect convert() to return 1});

my $docs = $diasql->_get_docs();
foreach my $doc (@{$docs}){
  isa_ok($doc, q{XML::DOM::Document});
}

# check that nodelists returns array of XML::DOM::NodeList
my $nodelists = $diasql->_get_nodelists();
foreach my $nodelist (@{$nodelists}){
  isa_ok($nodelist, q{XML::DOM::NodeList});
}

my $classes = $diasql->get_classes_ref(); # no parsing

# Expect an array ref with 3 elements
isa_ok($classes, 'ARRAY');
cmp_ok(scalar(@$classes), q{==}, 3, q{Expect 3 classes});

# List of classes in the dia file
my %classname = map { $_ => 1 } qw (
  student
  course
  student_course
);

foreach my $class(@$classes) {
  isa_ok($class, 'HASH');
  if (exists($classname{$class->{name}})) {
	delete $classname{$class->{name}};
	ok(1);
	#diag(q{Found class }. $class->{name})
  } else {
	fail();
	diag(q{Unknown class: }. $class->{name});
  }
}

# Expect no classes left now
cmp_ok(scalar(keys %classname), q{==}, 0, q{Expect 0 classes});


$classes = $diasql->get_classes_ref(); # no parsing
# List of objects and types
%classname = map { $_ => 'table' } qw (
  student
  course
  student_course
);

# Check that each class is of the expected type (table or view)
foreach my $class (@$classes) {
  isa_ok($class, 'HASH');
  ok(exists($classname{$class->{name}}));
  is($class->{type}, $classname{$class->{name}}, $class->{name}
          . q{ is of type }
          . $class->{type}
          . q{ expected }
          . $classname{ $class->{name}});
  delete $classname{$class->{name}};
}

# Expect no classes left now
cmp_ok(scalar(keys %classname), q{==}, 0, q{Expect 0 classes});

# Hash with class/view names as keys and attribute list as (hashref) elements
my %attList = (
  student => [
    [ 'ssn',  'int',          '',         '2', '' ],
    [ 'name', 'varchar(256)', 'not null', '0', '' ]
  ],
  course => [
    [ 'course_id',   'int',         '',         '2', '' ],
    [ 'desc',        'varchar(64)', 'not null', '0', '' ],
    [ 'day_of_week', 'int',         'not null', '0', '' ],
    [ 'starttime',   'timestamp',   'not null', '0', '' ],
    [ 'endtime',     'timestamp',   '',         '0', '' ]
  ],
  student_course =>
    [ [ 'ssn', 'int', '', 2, '' ], [ 'course_id', 'int', '', 2, '' ] ],
);

$classes = $diasql->get_classes_ref(); # no parsing
# Check that each class has of the expected attList attributes
foreach my $class (@$classes) {
  isa_ok($class, 'HASH');
  ok(exists($attList{$class->{name}}));
  #diag($class->{name} . ": " . Dumper($class->{attList}));

  # check contents
  is_deeply(
			$class->{attList},
			$attList{ $class->{name} },
			q{attList for } . $class->{name}
		   );

  # remove key-value pair from hash
  delete $attList{$class->{name}};
}


__END__