/[Frey]/trunk/lib/App/RoomReservation/Reservation.pm
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /trunk/lib/App/RoomReservation/Reservation.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1164 - (hide annotations)
Thu Jul 2 17:59:56 2009 UTC (14 years, 9 months ago) by dpavlin
File size: 2641 byte(s)
support submit button label
1 dpavlin 1086 package App::RoomReservation::Reservation;
2     use Moose;
3    
4 dpavlin 1118 use Moose::Util::TypeConstraints;
5     use Regexp::Common qw[Email::Address];
6    
7     subtype 'Email',
8     as 'Str',
9     where { /^$RE{Email}{Address}$/ },
10     message { "$_ is not valid e-mail" };
11    
12 dpavlin 1098 extends 'App::RoomReservation';
13 dpavlin 1086
14 dpavlin 1152 with 'App::RoomReservation::Email', 'App::RoomReservation::Messages';
15 dpavlin 1134
16 dpavlin 1095 use lib 'lib';
17     use Frey::PPI;
18    
19 dpavlin 1086 has ime => (
20     is => 'rw',
21     isa => 'Str',
22     required => 1,
23     );
24    
25     has prezime => (
26     is => 'rw',
27     isa => 'Str',
28     required => 1,
29     );
30    
31     has institucija => (
32     is => 'rw',
33     isa => 'Str',
34     required => 1,
35     );
36    
37     has zanimanje => (
38     is => 'rw',
39     isa => 'Str',
40     required => 1,
41     );
42    
43     has grad => (
44     is => 'rw',
45     isa => 'Str',
46     required => 1,
47     );
48    
49     has drzava => (
50     is => 'rw',
51     isa => 'Str',
52     required => 1,
53     );
54    
55     has telefon => (
56     is => 'rw',
57     isa => 'Str',
58     required => 1,
59     );
60    
61     has mobitel => (
62     is => 'rw',
63     isa => 'Str',
64 dpavlin 1162 default => '', # FIXME without this we get undef in form
65 dpavlin 1086 );
66    
67     has email => (
68     is => 'rw',
69 dpavlin 1118 isa => 'Email',
70 dpavlin 1086 required => 1,
71     );
72    
73     has email_verify => (
74     is => 'rw',
75 dpavlin 1118 isa => 'Email',
76 dpavlin 1086 required => 1,
77     );
78    
79     has _confirmed => (
80     is => 'rw',
81     isa => 'Bool',
82 dpavlin 1118 # required => 1,
83 dpavlin 1086 default => sub { 0 },
84     );
85    
86 dpavlin 1121 has _seat_number => (
87     is => 'rw',
88     isa => 'Int',
89     );
90    
91 dpavlin 1155 has _canceled => (
92     is => 'rw',
93     isa => 'Bool',
94     default => sub { 0 },
95     );
96    
97 dpavlin 1160 sub form_labels {{
98     ime => 'Ime',
99     prezime => 'Prezime',
100     institucija => 'Institucija',
101 dpavlin 1163 zanimanje => 'Zanimanje',
102 dpavlin 1160 grad => 'Grad',
103     drzava => 'Država',
104     telefon => 'Telefon',
105     mobitel => 'Mobitel',
106     email => 'e-mail adresa',
107     verify => 'unesite ponovo',
108 dpavlin 1164 submit => 'Pošalji', # submit button
109 dpavlin 1160 }}
110    
111 dpavlin 1104 sub BUILD {
112     my $self = shift;
113 dpavlin 1152 my $email = $self->email;
114     die "e-mail not verified\n" unless $email eq $self->email_verify;
115 dpavlin 1120 my $sth = $self->dbh->prepare(qq{
116     select count(*) from reservation where email = ?
117     });
118 dpavlin 1152 $sth->execute( $email );
119 dpavlin 1120 my ($registred) = $sth->fetchrow_array;
120 dpavlin 1152 if ( $registred ) {
121     die qq|
122     <big>e-mail address $email allready registred</big>
123     | . $self->seat_confirmation_message( email => $email )
124     ;
125     }
126 dpavlin 1104 }
127    
128 dpavlin 1095 my @cols = Frey::PPI->new( class => __PACKAGE__ )->attribute_order;
129     warn "# cols = ",join(',', @cols), $/;
130    
131     sub create_as_markup {
132 dpavlin 1086 my ($self) = @_;
133    
134 dpavlin 1095 my @vals;
135     my @p;
136    
137     map {
138     push @vals, $self->$_;
139     push @p, '?';
140     } @cols;
141    
142     my $n = $#cols + 1;
143    
144     my $sql
145     = 'insert into reservation ('
146     . join(',', @cols)
147     . ') values ('
148     . join(',', map { '?' } @cols )
149     . ')'
150     ;
151    
152     warn "sql: $sql\n";
153    
154 dpavlin 1098 my $sth = $self->dbh->prepare( $sql );
155 dpavlin 1095 $sth->execute( @vals );
156    
157 dpavlin 1153 return $self->seat_confirmation_message( email => $self->email );
158 dpavlin 1147
159 dpavlin 1086 }
160    
161 dpavlin 1133 __PACKAGE__->meta->make_immutable;
162     no Moose;
163     no Moose::Util::TypeConstraints;
164 dpavlin 1098
165 dpavlin 1086 1;

  ViewVC Help
Powered by ViewVC 1.1.26