/[Frey]/branches/zimbardo/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 /branches/zimbardo/lib/App/RoomReservation/Reservation.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1181 - (hide annotations)
Tue Jul 7 22:07:51 2009 UTC (14 years, 10 months ago) by dpavlin
File size: 3327 byte(s)
 r4308@llin (orig r1175):  dpavlin | 2009-07-06 22:27:57 +0200
 adaptive length of input type=text on form using new form_value_len
 which is implemented by App class
 r4309@llin (orig r1176):  dpavlin | 2009-07-07 14:28:59 +0200
 fix revert and postpone for first file in diff
 r4310@llin (orig r1177):  dpavlin | 2009-07-07 22:11:24 +0200
 take a look at new mst toy (DBIx::Class refactoring into Moose goodness)
 r4311@llin (orig r1178):  dpavlin | 2009-07-07 22:11:44 +0200
 use number of seats from room definition
 r4312@llin (orig r1179):  dpavlin | 2009-07-07 22:12:50 +0200
 wrap title call to application class in eval (sometimes it needs instance of class)
 r4313@llin (orig r1180):  dpavlin | 2009-07-07 22:53:55 +0200
 added mime headers and charset

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 dpavlin 1173 message { qq|<error>$_ nije valjana e-mail adresa / $_ is not valid e-mail address</error>| };
11 dpavlin 1118
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 dpavlin 1173 ime => 'Ime / Name',
99     prezime => 'Prezime / Surname',
100     institucija => 'Institucija / Institution',
101     zanimanje => 'Zanimanje / Profession',
102     grad => 'Grad / City',
103     drzava => 'Država / Country',
104     telefon => 'Telefon / Phone',
105     mobitel => 'Mobitel / Cellular phone',
106     email => 'e-mail',
107     verify => 'ponovo / again',
108     submit => 'Pošalji / Submit', # submit button
109 dpavlin 1160 }}
110    
111 dpavlin 1181 sub form_value_len {
112     my $self = shift;
113     my $sth = $self->dbh->prepare(qq{
114     select * from reservation limit 1
115     });
116     $sth->execute;
117     my @columns = $sth->fetchrow_array;
118    
119     $sth = $self->dbh->prepare(qq{
120     select
121     } . join(',', map { "max(length($_)) as $_" } grep { !/^_/ && !/id/ } @{ $sth->{NAME} } ) . qq{
122     from reservation
123     });
124     $sth->execute;
125     my $max_len = $sth->fetchrow_hashref;
126     warn "# max_len = ", $self->dump( $max_len );
127     return $max_len;
128     }
129    
130 dpavlin 1104 sub BUILD {
131     my $self = shift;
132 dpavlin 1152 my $email = $self->email;
133 dpavlin 1165 die qq|<error>e-mail addresses not same</error>| unless $email eq $self->email_verify;
134 dpavlin 1120 my $sth = $self->dbh->prepare(qq{
135     select count(*) from reservation where email = ?
136     });
137 dpavlin 1152 $sth->execute( $email );
138 dpavlin 1120 my ($registred) = $sth->fetchrow_array;
139 dpavlin 1152 if ( $registred ) {
140 dpavlin 1165 die
141     qq|
142     <error>
143 dpavlin 1173 <big>e-mail $email je već registriran / allready registred</big>
144     <br><br>
145 dpavlin 1165 |
146     . $self->seat_confirmation_message( email => $email )
147     . qq|
148     </error>
149     |
150 dpavlin 1152 ;
151     }
152 dpavlin 1104 }
153    
154 dpavlin 1095 my @cols = Frey::PPI->new( class => __PACKAGE__ )->attribute_order;
155     warn "# cols = ",join(',', @cols), $/;
156    
157     sub create_as_markup {
158 dpavlin 1086 my ($self) = @_;
159    
160 dpavlin 1095 my @vals;
161     my @p;
162    
163     map {
164     push @vals, $self->$_;
165     push @p, '?';
166     } @cols;
167    
168     my $n = $#cols + 1;
169    
170     my $sql
171     = 'insert into reservation ('
172     . join(',', @cols)
173     . ') values ('
174     . join(',', map { '?' } @cols )
175     . ')'
176     ;
177    
178     warn "sql: $sql\n";
179    
180 dpavlin 1098 my $sth = $self->dbh->prepare( $sql );
181 dpavlin 1095 $sth->execute( @vals );
182    
183 dpavlin 1153 return $self->seat_confirmation_message( email => $self->email );
184 dpavlin 1147
185 dpavlin 1086 }
186    
187 dpavlin 1133 __PACKAGE__->meta->make_immutable;
188     no Moose;
189     no Moose::Util::TypeConstraints;
190 dpavlin 1098
191 dpavlin 1086 1;

  ViewVC Help
Powered by ViewVC 1.1.26