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

« back to all changes in this revision

Viewing changes to Embperl/Form/Control/duration.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
[ 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:
 
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::duration ;
 
19
 
 
20
use strict ;
 
21
use base 'Embperl::Form::Control::number' ;
 
22
 
 
23
use Embperl::Inline ;
 
24
 
 
25
use vars qw{%fdat} ;
 
26
 
 
27
# ---------------------------------------------------------------------------
 
28
#
 
29
#   init - init the new control
 
30
#
 
31
 
 
32
sub init
 
33
 
 
34
    {
 
35
    my ($self) = @_ ;
 
36
 
 
37
    $self->{unit}      ||= '' ;
 
38
    
 
39
    return $self ;
 
40
    }
 
41
    
 
42
# ------------------------------------------------------------------------------------------
 
43
#
 
44
#   init_data - daten aufteilen
 
45
#
 
46
 
 
47
sub init_data
 
48
    {
 
49
    my ($self, $req, $parentctrl) = @_ ;
 
50
    
 
51
    my $fdat  = $req -> {docdata} || \%fdat ;
 
52
    my $name    = $self->{name} ;
 
53
    my $val     = $fdat->{$name} ;
 
54
    return if ($val eq '') ;
 
55
 
 
56
    my $aval = abs ($val) ;
 
57
    my $sec = $aval % 60 ;
 
58
    my $min = int ($aval / 60) % 60 ;
 
59
    my $hour = int($aval / 3600) ;
 
60
    
 
61
    my $duration = ($val<0?'-':'') . ($hour?sprintf('%d:%02d', $hour, $min):$min) ;
 
62
    if ($sec != 0)
 
63
        {
 
64
        $duration .= sprintf (':%02d', $sec) ;
 
65
        }
 
66
    $fdat->{$name} = $duration ;
 
67
    }
 
68
 
 
69
# ------------------------------------------------------------------------------------------
 
70
#
 
71
#   prepare_fdat - daten zusammenfuehren
 
72
#
 
73
 
 
74
sub prepare_fdat
 
75
    {
 
76
    my ($self, $req) = @_ ;
 
77
 
 
78
    my $fdat  = $req -> {form} || \%fdat ;
 
79
    my $name    = $self->{name} ;
 
80
    my $val     = $fdat->{$name} ;
 
81
    return if ($val eq '') ;
 
82
    
 
83
    my $neg = 0 ;
 
84
    $neg = 1 if ($val =~ s/^\s*-//) ;
 
85
    my @vals = split (/:/, $val, 3) ;
 
86
     
 
87
 
 
88
        
 
89
    $fdat->{$name} = @vals == 1?$vals[0] * 60:$vals[0] * 3600 + $vals[1] * 60 + $vals[2] ;
 
90
    $fdat->{$name} = - $fdat{$name} if ($neg) ;
 
91
    }
 
92
 
 
93
1 ;
 
94
 
 
95
__EMBPERL__
 
96
 
 
97
 
 
98
__END__
 
99
 
 
100
=pod
 
101
 
 
102
=head1 NAME
 
103
 
 
104
Embperl::Form::Control::price - A price input control with optional unit inside an Embperl Form
 
105
 
 
106
 
 
107
=head1 SYNOPSIS
 
108
 
 
109
  {
 
110
  type => 'price',
 
111
  text => 'blabla',
 
112
  name => 'foo',
 
113
  unit => 'sec',
 
114
  }
 
115
 
 
116
=head1 DESCRIPTION
 
117
 
 
118
Used to create a price input control inside an Embperl Form.
 
119
Will format number as a money ammout.
 
120
Optionaly it can display an unit after the input field.
 
121
See Embperl::Form on how to specify parameters.
 
122
 
 
123
=head2 PARAMETER
 
124
 
 
125
=head3 type
 
126
 
 
127
Needs to be 'price'
 
128
 
 
129
=head3 name
 
130
 
 
131
Specifies the name of the control
 
132
 
 
133
=head3 text
 
134
 
 
135
Will be used as label for the numeric input control
 
136
 
 
137
=head3 size
 
138
 
 
139
Gives the size in characters. (Default: 10)
 
140
 
 
141
=head3 maxlength
 
142
 
 
143
Gives the maximun length in characters
 
144
 
 
145
=head3 unit
 
146
 
 
147
Gives a string that should be displayed right of the input field.
 
148
(Default: �)
 
149
 
 
150
=head3 use_comma
 
151
 
 
152
If set the decimal character is comma instead of point (Default: on)
 
153
 
 
154
=head1 Author
 
155
 
 
156
G. Richter (richter at embperl dot org)
 
157
 
 
158
=head1 See Also
 
159
 
 
160
perl(1), Embperl, Embperl::Form
 
161
 
 
162