← Back to branch summary

~ubuntu-branches/debian/sid/libembperl-perl/sid

« back to all changes in this revision

Viewing changes to Embperl/Form/Control/datetime.pm

  • Committer: Package Import Robot
  • Author(s): Florian Schlichting, Jonathan Yu, Salvatore Bonaccorso, Dominic Hargreaves, Ansgar Burchardt, Florian Schlichting
  • Date: 2012-10-02 22:39:09 UTC
  • mfrom: (1.2.5)
  • Revision ID: package-import@ubuntu.com-20121002223909-vhrio164s2xa8qd3
Tags: 2.5.0~rc2-1
http://bugs.debian.org/624578
http://bugs.debian.org/666011
[ Jonathan Yu ]
* Imported Upstream version 2.4.0.

[ Salvatore Bonaccorso ]
* debian/copyright: Re-add Ryan and Gregor to copyright for debian/*
  packaging.

[ Dominic Hargreaves ]
* Switch to dpkg-source 3.0 (quilt) format.
* Remove obsolete perl5.10.patch, perl5.12.patch.

[ Ansgar Burchardt ]
* debian/control: Convert Vcs-* fields to Git.

[ Florian Schlichting ]
* Imported Upstream version 2.5.0~rc2 (Closes: #624578, #666011).
* Patches forwarded upstream and thus obsoleted:
  german.patch, new_process_group.patch, utf8.patch, fix-pod-errors.patch,
  fix-whatis.patch, fix-string-typo.patch, fix-pod-unescaped-unicode.patch.
* Refreshed delay.patch (fuzz).
* Dropped modperl.patch, mod_perl versions < 2 are history.
* Dropped Makefile.PL.patch, divide et impera - style:
  + FORCEMP1 is no longer relevant, Makefile.PL can find Apache headers etc
    itself
  + replacing a custom prompt implementation is unnecessary
  + strip .pl suffix in debian/rules instead of Makefile.PL
  + with hardening flags enabled, there is nothing left in the output of
    `apxs2 -q CFLAGS` that makes a difference
* Bumped Standards-Version to 3.9.4 (using copyright-format 1.0) and updated
  upstream copyright holders.
* Switched dh compatibility to level 9 to enable passing of hardening flags.
* Switched to short-form debian/rules.
* Deleted obsolete README.source.
* Removed version on mod-perl dependency (no older version in the archive).
* Moved apache2-mpm-prefork from Suggests: to Recommends:.
* Updated short and long description.
* Replaced embedded code copy (prototype.js) by a symlink and suggest:
  libjs-prototype.
* Added myself to uploaders and copyright.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Embperl/Form/Control/datetime.pm
 
1
 
 
2
###################################################################################
 
3
#
 
4
#   Embperl - Copyright (c) 1997-2008 Gerald Richter / ecos gmbh  www.ecos.de
 
5
#   Embperl - Copyright (c) 2008-2012 Gerald Richter
 
6
#
 
7
#   You may distribute under the terms of either the GNU General Public
 
8
#   License or the Artistic License, as specified in the Perl README file.
 
9
#
 
10
#   THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
 
11
#   IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
 
12
#   WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 
13
#
 
14
#   $Id$
 
15
#
 
16
###################################################################################
 
17
 
 
18
package Embperl::Form::Control::datetime ;
 
19
 
 
20
use strict ;
 
21
use base 'Embperl::Form::Control::number' ;
 
22
 
 
23
use Embperl::Inline ;
 
24
use POSIX qw(strftime);
 
25
use Time::Local qw(timelocal_nocheck timegm_nocheck);
 
26
use Date::Calc qw{Delta_DHMS Add_Delta_Days} ;
 
27
 
 
28
use vars qw{%fdat} ;
 
29
 
 
30
our $tz_local = (timegm_nocheck(localtime())-time())/60;
 
31
 
 
32
 
 
33
# ---------------------------------------------------------------------------
 
34
#
 
35
#   init - init the new control
 
36
#
 
37
 
 
38
sub init
 
39
 
 
40
    {
 
41
    my ($self) = @_ ;
 
42
 
 
43
    $self->{unit}      ||= '' ;
 
44
 
 
45
    
 
46
    return $self ;
 
47
    }
 
48
    
 
49
# ------------------------------------------------------------------------------------------
 
50
#
 
51
#   init_data - daten aufteilen
 
52
#
 
53
 
 
54
sub init_data
 
55
    {
 
56
    my ($self, $req, $parentctrl) = @_ ;
 
57
 
 
58
    my $fdat  = $req -> {docdata} || \%fdat ;
 
59
    my $name    = $self->{name} ;
 
60
    my $time    = $fdat->{$name} ;
 
61
    return if ($time eq '' || $req -> {"ef_datetime_init_done_$name"}) ;
 
62
 
 
63
    if ($self -> {dynamic} && ($time =~ /^\s*((?:d|m|y)(?:\+|-)?(?:\d+)?)\s*$/))
 
64
        {
 
65
        $fdat->{$name} = $1 ;
 
66
 
 
67
        $req -> {"ef_datetime_init_done_$name"} = 1 ;
 
68
        return ;
 
69
        }
 
70
    
 
71
    
 
72
    my ($y, $m, $d, $h, $min, $s, $z) = ($time =~ /^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(.)/) ;
 
73
 
 
74
    # Getting the local timezone
 
75
 
 
76
    my $date = eval
 
77
        {
 
78
        my @time = gmtime(timegm_nocheck($s,$min,$h,$d,$m-1,$y-1900)+($tz_local*60));
 
79
 
 
80
        my $format = $self -> {notime} || ($s == 0 && $h == 0 && $min == 0)?'%d.%m.%Y':'%d.%m.%Y, %H:%M' ;
 
81
        strftime ($format, @time[0..5]) ;
 
82
        } ;
 
83
 
 
84
    if ($time && !$date && ($time =~ /\d+\.\d+\.\d+/))
 
85
        {
 
86
        $date = $time ;
 
87
        }
 
88
 
 
89
    $fdat->{$name} = $date ;
 
90
    $req -> {"ef_datetime_init_done_$name"} = 1 ;
 
91
    }
 
92
 
 
93
# ------------------------------------------------------------------------------------------
 
94
#
 
95
#   prepare_fdat - daten zusammenfuehren
 
96
#
 
97
 
 
98
sub prepare_fdat
 
99
    {
 
100
    my ($self, $req) = @_ ;
 
101
 
 
102
    return if ($self -> is_readonly ($req)) ;
 
103
    
 
104
    my $fdat  = $req -> {form} || \%fdat ;
 
105
    my $name    = $self->{name} ;
 
106
    my $date    = $fdat -> {$name} ;
 
107
    return if ($date eq '') ;
 
108
 
 
109
    if ($self -> {dynamic} && ($date =~ /^\s*((?:d|m|y)\s*(?:\+|-)?\s*(?:\d+)?)\s*$/))
 
110
        {
 
111
        $fdat->{$name} = $1 ;
 
112
        $fdat->{$name} =~ s/\s//g ;
 
113
        return ;
 
114
        }
 
115
    
 
116
    
 
117
    my ($year, $mon, $day, $hour, $min, $sec) ;
 
118
    if ($date eq '*' || $date eq '.')
 
119
        {
 
120
        my $offset ||= 0 ;
 
121
        ($sec, $min, $hour, $day, $mon, $year) = gmtime (time + $offset) ;
 
122
        $year += 1900 ;
 
123
        $mon++ ;
 
124
        }
 
125
    else
 
126
        {
 
127
        $date =~ tr/,;/  / ;
 
128
        my ($d, $t) = split (/\s+/, $date) ;
 
129
        if ($d =~ /:/)
 
130
            {
 
131
            $t = $d ;
 
132
            $d = '' ;
 
133
            }
 
134
        ($day, $mon, $year) = map { $_ + 0 } split (/\./, $d) ;
 
135
        ($hour, $min, $sec) = map { $_ + 0 } split (/\:/, $t) ;
 
136
 
 
137
        if ($year == 0 || $mon == 0 || $day == 0)
 
138
            {
 
139
            my ($s, $min, $h, $md, $m, $y) = localtime ;
 
140
 
 
141
            $day  ||= $md ;
 
142
            $mon  ||= $m + 1;
 
143
            $year ||= $y + 1900 ;
 
144
            }
 
145
 
 
146
        if ($year < 70)
 
147
            {
 
148
            $year += 2000 ;
 
149
            }
 
150
        elsif ($year >= 70 && $year < 100)
 
151
            {
 
152
            $year += 1900 ;
 
153
            }
 
154
        if ($year < 1907)
 
155
            {
 
156
            $year = $year % 100 + 2000 ;
 
157
            }
 
158
 
 
159
        ($year,$mon,$day, $hour,$min,$sec) =
 
160
             Date::Calc::Add_Delta_DHMS($year,$mon,$day, $hour,$min,$sec,
 
161
                            0, 0, -$tz_local, 0) if ($hour || $min || $sec) ;
 
162
        }
 
163
 
 
164
    $fdat -> {$name} = $year?sprintf ('%04d%02d%02d%02d%02d%02dZ', $year, $mon, $day, $hour, $min, $sec):'' ;
 
165
    }
 
166
 
 
167
# ---------------------------------------------------------------------------
 
168
#
 
169
#   get_validate_auto_rules - get rules for validation, in case user did
 
170
#                             not specify any
 
171
#
 
172
 
 
173
sub get_validate_auto_rules
 
174
    {
 
175
    my ($self, $req) = @_ ;
 
176
    
 
177
    return [ $self -> {required}?(required => 1):(emptyok => 1), -type => 'DateTime' ] ;
 
178
    }
 
179
 
 
180
1 ;
 
181
 
 
182
__EMBPERL__
 
183
 
 
184
 
 
185
[# ---------------------------------------------------------------------------
 
186
#
 
187
#   show_control - output the control
 
188
#]
 
189
 
 
190
[$ sub show_control ($self)
 
191
 
 
192
$self -> {size} ||= 80 / ($self -> {width} || 2) ;
 
193
my $class = $self -> {class} ||= '' ;
 
194
my $fullid   = $req -> {uuid} . '_' . $self ->{id} ;
 
195
$]
 
196
 
 
197
<input type="text" name="[+ $self -> {force_name} || $self -> {name} +]"  [+ do { local $escmode = 0 ; $self -> get_std_control_attr($req, $fullid) } +]
 
198
[$if $self -> {size} $]size="[+ $self->{size} +]"[$endif$]
 
199
[$if $self -> {maxlength} $]maxlength="[+ $self->{maxlength} +]"[$endif$]
 
200
>
 
201
<script type="text/javascript">
 
202
    $('#[+ $fullid +]').datepicker ({ showWeek: true,
 
203
                                    [$if $self -> {dynamic} $]constrainInput: false, [$endif$]
 
204
                                    showButtonPanel: true
 
205
                                    }) ;
 
206
</script>
 
207
 
 
208
 
 
209
[$endsub$]
 
210
 
 
211
 
 
212
__END__
 
213
 
 
214
=pod
 
215
 
 
216
=head1 NAME
 
217
 
 
218
Embperl::Form::Control::price - A price input control with optional unit inside an Embperl Form
 
219
 
 
220
 
 
221
=head1 SYNOPSIS
 
222
 
 
223
  {
 
224
  type => 'price',
 
225
  text => 'blabla',
 
226
  name => 'foo',
 
227
  unit => 'sec',
 
228
  }
 
229
 
 
230
=head1 DESCRIPTION
 
231
 
 
232
Used to create a datetime input control inside an Embperl Form.
 
233
Will format number as a date/time.
 
234
See Embperl::Form on how to specify parameters.
 
235
 
 
236
Datetime format in %fdat is excpected as YYYYMMTTHHMMSSZ
 
237
 
 
238
=head2 PARAMETER
 
239
 
 
240
=head3 type
 
241
 
 
242
Needs to be 'datetime'
 
243
 
 
244
=head3 name
 
245
 
 
246
Specifies the name of the control
 
247
 
 
248
=head3 text
 
249
 
 
250
Will be used as label for the numeric input control
 
251
 
 
252
=head3 size
 
253
 
 
254
Gives the size in characters. (Default: 10)
 
255
 
 
256
=head3 notime
 
257
 
 
258
does not display time
 
259
 
 
260
=head3 dynamic
 
261
 
 
262
allows the following values to be entered:
 
263
 
 
264
d, m, y, d-N, d+N, m-N, m+N, y-N, y+N
 
265
 
 
266
N is any number. This values are simply passed through and need
 
267
to be process somewhere else.
 
268
 
 
269
=head1 Author
 
270
 
 
271
G. Richter (richter at embperl dot org)
 
272
 
 
273
=head1 See Also
 
274
 
 
275
perl(1), Embperl, Embperl::Form
 
276
 
 
277