File: store4.t

package info (click to toggle)
libdbix-dbstag-perl 0.12-2
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, stretch
  • size: 1,424 kB
  • ctags: 826
  • sloc: perl: 6,152; sql: 588; xml: 221; lisp: 59; makefile: 20
file content (121 lines) | stat: -rw-r--r-- 2,999 bytes parent folder | download | duplicates (3)
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
use lib 't';

BEGIN {
    # to handle systems with no installed Test module
    # we include the t dir (where a copy of Test.pm is located)
    # as a fallback
    eval { require Test; };
    use Test;    
    use DBStagTest;
    plan tests => 4;
}
use DBIx::DBStag;
use DBI;
use Data::Stag;
use FileHandle;
use strict;

drop qw( person2address person address );

my $ddl = <<EOM
CREATE TABLE address (
  address_id serial NOT NULL PRIMARY KEY,
  addressline varchar(255),
  city VARCHAR(255)
);
CREATE TABLE person (
  person_id serial NOT NULL PRIMARY KEY,
  fname     varchar(255),
  lname     varchar(255),
  UNIQUE (fname, lname)
);
CREATE TABLE person2address (
  address_id   integer REFERENCES address(address_id),
  person_id    integer REFERENCES  person(person_id)
);
EOM
;

my $data = <<EOM
(personset
 (person
  (fname "joe")
  (lname "bloggs")
  (address 
   (addressline "1 a street")
   (city "san francisco"))
  (address 
   (addressline "2 b street")
   (city "san francisco"))
 )
 (person
  (fname "fred")
  (lname "minger")
  (address 
   (addressline "5555 bogging avenue")
   (city "LA"))))
EOM
;

my $dbh = connect_to_cleandb();
#DBI->trace(1);

$dbh->do($ddl);
$dbh->trust_primary_key_values(1);

$dbh->guess_mapping;

my $personset = Data::Stag->from('sxprstr', $data);
$dbh->linking_tables(person2address => [qw(person address)]);
#$dbh->add_linking_tables($personset);
#die $personset->sxpr;                                                         
my @persons  = $personset->getnode_person;
foreach (@persons) {
    $dbh->storenode($_);
}

my @q = ("SELECT person.*, address.* FROM person NATURAL JOIN person2address NATURAL JOIN address WHERE person.fname = 'joe' ORDER BY addressline",
         "(personset(person(address 1)))");
my $rset = $dbh->selectall_stag(@q
                               );
print $rset->sxpr;
my $joe = $rset->getnode_person;
my $first_address = $joe->sgetnode_address;
my $OLD_ADDRESS = $first_address->sget_addressline;
our $NEW_ADDRESS = $OLD_ADDRESS . "; appartment C";

$first_address->set_addressline($NEW_ADDRESS);
print "added appt\n";
print $joe->sxpr, "\n";
$dbh->storenode($joe);
$rset = $dbh->selectall_stag(@q
                            );
$joe = $rset->getnode_person;
my @addresses = $joe->get_address;
ok(@addresses == 2);
ok($joe->sgetnode_address->sget_addressline eq $NEW_ADDRESS);

$joe->unset_person_id;
$joe->sgetnode_address->set_addressline($OLD_ADDRESS);

print "unset person_id\n";
print $joe->sxpr, "\n";
$dbh->storenode($joe);
$rset = $dbh->selectall_stag(@q
                            );
$joe = $rset->getnode_person;
print $joe->sxpr, "\n";
ok($joe->sget_address->sget_addressline eq $OLD_ADDRESS);

$rset = $dbh->selectall_stag(@q
                               );
print $rset->sxpr;
$joe = $rset->getnode_person;
$joe->set_lname('bliggs');
$dbh->storenode($joe);

$rset = $dbh->selectall_stag(@q
                            );
print $rset->sxpr;
ok($rset->get_person->get_lname eq 'bliggs');
$dbh->disconnect;