line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBR::Misc::Session; |
2
|
|
|
|
|
|
|
|
3
|
18
|
|
|
18
|
|
118
|
use strict; |
|
18
|
|
|
|
|
41
|
|
|
18
|
|
|
|
|
958
|
|
4
|
18
|
|
|
18
|
|
159
|
use base 'DBR::Common'; |
|
18
|
|
|
|
|
42
|
|
|
18
|
|
|
|
|
3323
|
|
5
|
18
|
|
|
18
|
|
29723
|
use DateTime::TimeZone; |
|
18
|
|
|
|
|
1542412
|
|
|
18
|
|
|
|
|
1051
|
|
6
|
18
|
|
|
18
|
|
250
|
use Carp; |
|
18
|
|
|
|
|
66
|
|
|
18
|
|
|
|
|
11284
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub new { |
9
|
17
|
|
|
17
|
0
|
64
|
my( $package ) = shift; |
10
|
|
|
|
|
|
|
|
11
|
17
|
|
|
|
|
142
|
my %params = @_; |
12
|
17
|
50
|
|
|
|
366
|
my $self = { |
|
|
50
|
|
|
|
|
|
13
|
|
|
|
|
|
|
logger => $params{logger}, |
14
|
|
|
|
|
|
|
admin => $params{admin} ? 1 : 0, |
15
|
|
|
|
|
|
|
fudge_tz => $params{fudge_tz}, |
16
|
|
|
|
|
|
|
use_exceptions => $params{use_exceptions} ? 1 : 0, |
17
|
|
|
|
|
|
|
}; |
18
|
|
|
|
|
|
|
|
19
|
17
|
|
|
|
|
70
|
bless( $self, $package ); |
20
|
|
|
|
|
|
|
|
21
|
17
|
50
|
|
|
|
224
|
croak ('logger is required') unless $self->{logger}; |
22
|
|
|
|
|
|
|
|
23
|
17
|
|
|
|
|
452
|
my $tz = ''; |
24
|
17
|
|
|
|
|
64
|
$self->{tzref} = \$tz; |
25
|
17
|
50
|
|
|
|
106
|
$self->timezone('server') or confess "failed to initialize timezone"; |
26
|
|
|
|
|
|
|
|
27
|
17
|
|
|
|
|
233
|
return $self; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub timezone { |
32
|
17
|
|
|
17
|
0
|
42
|
my $self = shift; |
33
|
17
|
|
|
|
|
45
|
my $tz = shift; |
34
|
|
|
|
|
|
|
|
35
|
17
|
50
|
|
|
|
93
|
return ${$self->{tzref}} unless defined($tz); |
|
0
|
|
|
|
|
0
|
|
36
|
|
|
|
|
|
|
|
37
|
17
|
50
|
|
|
|
83
|
if($tz eq 'server' ){ |
38
|
17
|
|
|
|
|
2779
|
eval { |
39
|
17
|
|
|
|
|
264
|
my $tzobj = DateTime::TimeZone->new( name => 'local'); |
40
|
17
|
|
|
|
|
296032
|
$tz = $tzobj->name; |
41
|
|
|
|
|
|
|
}; |
42
|
17
|
50
|
|
|
|
325
|
if($@){ |
43
|
0
|
0
|
|
|
|
0
|
if($self->{fudge_tz}){ |
44
|
0
|
|
|
|
|
0
|
$self->_log( "Failed to determine local timezone. Fudging to UTC"); |
45
|
0
|
|
|
|
|
0
|
$tz = 'UTC'; |
46
|
|
|
|
|
|
|
}else{ |
47
|
0
|
|
|
|
|
0
|
return $self->_error( "Failed to determine local timezone ($@)" ); |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
} |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
17
|
50
|
|
|
|
120
|
DateTime::TimeZone->is_valid_name( $tz ) or return $self->_error( "Invalid Timezone '$tz'" ); |
53
|
|
|
|
|
|
|
|
54
|
17
|
|
|
|
|
1663
|
$self->_logDebug2('Set timezone to ' . $tz); |
55
|
|
|
|
|
|
|
|
56
|
17
|
|
|
|
|
42
|
return ${$self->{tzref}} = $tz; |
|
17
|
|
|
|
|
157
|
|
57
|
|
|
|
|
|
|
} |
58
|
32
|
|
|
32
|
0
|
219
|
sub timezone_ref{ $_[0]->{tzref} } |
59
|
|
|
|
|
|
|
|
60
|
46
|
|
|
46
|
0
|
401
|
sub is_admin{ $_[0]->{admin} } |
61
|
7
|
|
|
7
|
0
|
50
|
sub use_exceptions{ $_[0]->{use_exceptions} } |
62
|
|
|
|
|
|
|
|
63
|
17
|
|
|
17
|
|
115
|
sub _session { $_[0] } |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub _log{ |
66
|
1569
|
|
|
1569
|
|
2929
|
my $self = shift; |
67
|
1569
|
|
|
|
|
2990
|
my $message = shift; |
68
|
1569
|
|
|
|
|
2577
|
my $mode = shift; |
69
|
|
|
|
|
|
|
|
70
|
1569
|
|
|
|
|
13575
|
my ( undef,undef,undef, $method) = caller(2); |
71
|
1569
|
|
|
|
|
14879
|
$self->{logger}->log($message,$method,$mode); |
72
|
|
|
|
|
|
|
|
73
|
1569
|
|
|
|
|
4907
|
return 1; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _directlog{ |
77
|
0
|
|
|
0
|
|
|
my $self = shift; |
78
|
0
|
|
|
|
|
|
my $message = shift; |
79
|
0
|
|
|
|
|
|
my $method = shift; |
80
|
0
|
|
|
|
|
|
my $mode = shift; |
81
|
|
|
|
|
|
|
|
82
|
0
|
|
|
|
|
|
$self->{logger}->log($message,$method,$mode) |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
1; |