File: process.t

package info (click to toggle)
libhtml-formhandler-model-dbic-perl 0.29-4
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 640 kB
  • sloc: perl: 1,873; sql: 259; makefile: 14
file content (130 lines) | stat: -rw-r--r-- 3,241 bytes parent folder | download | duplicates (4)
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
use strict;
use warnings;
use Test::More;
use lib 't/lib';

use_ok( 'HTML::FormHandler' );

use_ok( 'BookDB::Form::Book');

use_ok( 'BookDB::Schema');

my $schema = BookDB::Schema->connect('dbi:SQLite:t/db/book.db');
ok($schema, 'get db schema');

my $form = BookDB::Form::Book->new;

ok( $form, 'no param new' );

$form->process( item_id => 1, schema => $schema, params => {} );
is( $form->item->id, 1, 'get item from item_id and schema');

ok( !$form->process( item_id => undef, schema => $schema ), 'Empty data' );

# This is munging up the equivalent of param data from a form
my $good = {
    'title' => 'How to Test Perl Form Processors',
    'genres' => [2, 4],
    'format'       => 2,
    'isbn'   => '123-02345-0502-2' ,
    'publisher' => 'EreWhon Publishing',
};

ok( $form->process( schema => $schema, params => $good ), 'Good data' );

is( $form->field( 'title' )->input, 'How to Test Perl Form Processors', 'Input created from params and not deleted in validate' );

my $book = $form->item;
END { $book->delete };
ok( $book->id != 1, 'this is not the same book');

ok ($book, 'get book object from form');

my $num_genres = $book->genres->count;
is( $num_genres, 2, 'multiple select list updated ok');

is( $form->field('format')->value, 2, 'get value for format' );

$good = {
    'title' => 'How to Test Perl Form Processors',
    'genres' => [2, 4],
    'format'       => 3,
    'isbn'   => '123-02345-0502-2' ,
    'publisher' => 'EreWhon Publishing',
};
ok( $form->process( item => $book, schema => $schema, params => $good ),
  'update book with another request' );

my $bad_1 = {
    notitle => 'not req',
    silly_field   => 4,
};
ok( !$form->process( schema => $schema, params => $bad_1 ), 'bad parameters' );


my $bad_2 = {
    'title' => "Another Silly Test Book",
    'year' => '1590',
    'pages' => 'too few',
    'format' => '22',
};

ok( !$form->process( schema => $schema, params => $bad_2 ), 'bad 2');

ok( $form->field('year')->has_errors, 'year has error' );

ok( $form->field('pages')->has_errors, 'pages has error' );

ok( $form->field('format')->has_errors, 'format has error' );



$form->process(item => $book, schema => $schema);
ok( $form, 'create form from db object');

my $genres_field = $form->field('genres');
is_deeply( sort $genres_field->value, [2, 4], 'value of multiple field is correct');

{
   package My::Form;
   use HTML::FormHandler::Moose;
   extends 'HTML::FormHandler';

   has_field 'field_one';
   has_field 'field_two';
   has_field 'field_three';

   sub validate_field_one
   {
      my ($self, $field) = @_;
      $field->add_error( 'Field does not contain ONE' )
         unless $field->value eq 'ONE';
   }
   sub validate_field_two
   {
      my ( $self, $field ) = @_;
      $field->add_error( 'Field does not contain TWO' )
         unless $field->value eq 'TWO';
    }
}

$form = My::Form->new;
ok( $form, 'get non-database form' );

my $bad = {
   field_one => 'BAD',
   field_two => 'BAD',
};

my $validated = $form->process( params => $bad );

ok( !$validated, 'bad params did not validate' );
$good = {
   field_one => 'ONE',
   field_two => 'TWO',
};

$validated = $form->process( params => $good );
ok( $validated, 'good params did validate' );

done_testing;