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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
#!perl
use warnings;
use strict;
use DBICx::TestDatabase;
use Test::More tests => 26;
use Path::Class qw/file/;
use File::Compare;
use lib qw(t/lib);
my $schema = DBICx::TestDatabase->new('My::TestSchema');
my $rs = $schema->resultset('Book');
# we'll use *this* file as our content
# TODO: Copy it or create something else so errant tests don't inadvertently
# delete it!
my $file = file($0);
my $book = $rs->create({
name => 'Alice in Wonderland',
cover_image => $file,
});
isa_ok( $book->cover_image, 'Path::Class::File' );
isnt( $book->cover_image, $file, 'storage is a different file' );
ok( compare($book->cover_image, $file) == 0, 'file contents equivalent');
# setting a file to itself should be a no-op
my $storage = Path::Class::File->new($book->cover_image);
$book->update({ cover_image => $storage });
is( $storage, $book->cover_image, 'setting storage to self' );
# deleting the row should delete the associated file
$book->delete;
ok( ! -e $storage, 'file successfully deleted' );
# multiple rows
my ($book1, $book2) = map {
$rs->create({ name => $_, cover_image => $file })
} qw/Book1 Book2/;
isnt( $book1->cover_image, $book2->cover_image, 'rows have different storage' );
$rs->delete;
ok ( ! -e $book1->cover_image, "storage deleted for row 1" );
ok ( ! -e $book2->cover_image, "storage deleted for row 2" );
# null fs_column
$book = $rs->create({ name => 'No cover image', cover_image => undef });
ok ( !defined $book->cover_image, 'null fs_column' );
# file handle
open my $fh, '<', $0 or die "failed to open $0 for read: $!\n";
$book->cover_image($fh);
$book->update;
close $fh or die;
ok( compare($book->cover_image, $0) == 0, 'store from filehandle' );
# missing fs_column
{
my $book = $rs->create({ name => 'No cover image' });
ok ( !defined $book->cover_image, 'missing fs_column' );
open my $fh, '<', $0 or die "failed to open $0 for read: $!\n";
$book->cover_image($fh);
$book->update;
close $fh or die;
$book->discard_changes; # reload from db
ok( defined $book->cover_image && compare($book->cover_image, $0) == 0,
'store from filehandle (missing fs column)' );
}
# setting fs_column to null should delete storage
$book = $rs->create({ name => 'Here today, gone tomorrow',
cover_image => $file });
$storage = $book->cover_image;
ok( -e $storage, 'storage exists before nulling' );
$book->update({ cover_image => undef });
ok( ! -e $storage, 'does not exist after nulling' );
$book->update({ cover_image => $file });
$book->update({ id => 999 });
$book->discard_changes;
ok( -e $book->cover_image, 'storage renamed on PK change' );
#--------------------------------- test copy ---------------------------------
my $orig_column_data = { %{$book->{_column_data}} };
my $copy = $book->copy;
isnt( $copy->cover_image, $book->cover_image, 'copy has its own file backing' );
ok( compare($copy->cover_image, $book->cover_image) == 0, 'copy contents correct' );
# an update of book shouldn't change the source's _column_data
is_deeply ( $book->{_column_data}, $orig_column_data, 'copy source unchanged' );
# Regression test (failed on a prior implementation of copy)
$book = $rs->find({ id => 1, });
ok( eval{ $copy = $book->copy }, 'copy works with selected elements' );
#----------------------------- infinite recursion ----------------------------
$book = $rs->create({
name => 'The Never Ending Story',
cover_image => $file,
cover_image_2 => $file,
});
my $cover_image = $book->cover_image->stringify;
my $cover_image_2 = $book->cover_image->stringify;
$book->update({ cover_image => $file, cover_image_2 => $file });
is( $book->cover_image, $cover_image, 'backing filename did not change' );
isnt( $book->cover_image_2, $cover_image_2, 'backing filename did change for fs_new_on_update column' );
SKIP: {
# ensure FS works with the proposed change for DBIC: make_column_dirty to delete {_column_data}{$column}
skip 'requires make_column_dirty', 1 unless $book->can('make_column_dirty');
$storage = $book->cover_image;
$book->make_column_dirty('cover_image');
delete $book->{_column_data}{cover_image};
$book->update;
is( $book->cover_image, $storage, 'file backikng filename unchanged')
};
ok($schema->resultset('Book')->search(undef, { select => [qw(id)], as => [qw(foo)] })->all);
{
# Objects that are never written to storage should have
# backing files removed.
$book = $rs->new({
name => 'The Unpublished Chronicles of MST',
cover_image => $file,
});
# force object deflation
$book->get_columns;
$storage = $book->cover_image;
isnt ( $storage, $file, 'object deflated' );
ok ( -e $storage, 'file backing exists' );
undef $book;
ok ( !-e $storage, 'storage deleted for un-inserted row' );
}
|
