line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package TeamCity::Message; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
35305
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
48
|
|
4
|
2
|
|
|
2
|
|
11
|
use warnings; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
88
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.02'; |
7
|
|
|
|
|
|
|
|
8
|
2
|
|
|
2
|
|
922
|
use Time::HiRes qw( time ); |
|
2
|
|
|
|
|
2058
|
|
|
2
|
|
|
|
|
7
|
|
9
|
|
|
|
|
|
|
|
10
|
2
|
|
|
2
|
|
242
|
use Exporter qw( import ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
661
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
## no critic (Modules::ProhibitAutomaticExportation) |
13
|
|
|
|
|
|
|
our @EXPORT = qw( tc_message ); |
14
|
|
|
|
|
|
|
## use critic |
15
|
|
|
|
|
|
|
our @EXPORT_OK = ( @EXPORT, 'tc_timestamp' ); |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub tc_message { |
18
|
6
|
|
|
6
|
1
|
15251
|
my %args = @_; |
19
|
|
|
|
|
|
|
|
20
|
6
|
|
50
|
|
|
22
|
my $type = delete $args{type} || 'message'; |
21
|
|
|
|
|
|
|
my $content = delete $args{content} |
22
|
6
|
50
|
|
|
|
20
|
or die 'You must provide a content argument to tc_message()'; |
23
|
|
|
|
|
|
|
|
24
|
6
|
|
|
|
|
12
|
my $msg = "##teamcity[$type"; |
25
|
|
|
|
|
|
|
|
26
|
6
|
100
|
|
|
|
16
|
if ( ref $content ) { |
27
|
4
|
|
|
|
|
8
|
for my $name ( sort keys %{$content} ) { |
|
4
|
|
|
|
|
16
|
|
28
|
5
|
|
|
|
|
11
|
my $value = $content->{$name}; |
29
|
5
|
|
|
|
|
15
|
$msg .= qq{ $name='} . _escape($value) . q{'}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$msg .= q{ timestamp='} . tc_timestamp() . q{'} |
33
|
4
|
50
|
|
|
|
18
|
unless $content->{timestamp}; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
else { |
36
|
2
|
50
|
|
|
|
7
|
$msg .= q{ '} . _escape($content) . q{'} or die $!; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
6
|
|
|
|
|
13
|
$msg .= "]\n"; |
40
|
|
|
|
|
|
|
|
41
|
6
|
|
|
|
|
14
|
return $msg; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub tc_timestamp { |
45
|
5
|
|
|
5
|
1
|
51
|
my $now = time; |
46
|
5
|
|
|
|
|
53
|
my ( $s, $mi, $h, $d, $mo, $y ) = ( gmtime($now) )[ 0 .. 5 ]; |
47
|
|
|
|
|
|
|
|
48
|
5
|
|
|
|
|
17
|
my $float = ( $now - int($now) ); |
49
|
5
|
|
|
|
|
52
|
return sprintf( |
50
|
|
|
|
|
|
|
'%4d-%02d-%02dT%02d:%02d:%02d.%03d', |
51
|
|
|
|
|
|
|
$y + 1900, $mo + 1, $d, |
52
|
|
|
|
|
|
|
$h, $mi, $s, |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# We only need 3 places of precision so if we multiply it by 1,000 we |
55
|
|
|
|
|
|
|
# can just treat it as an integer. |
56
|
|
|
|
|
|
|
$float * 1000, |
57
|
|
|
|
|
|
|
); |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub _escape { |
61
|
7
|
|
|
7
|
|
11
|
my $str = shift; |
62
|
|
|
|
|
|
|
|
63
|
7
|
|
|
|
|
32
|
( my $esc = $str ) =~ s{(['|\]])}{|$1}g; |
64
|
7
|
|
|
|
|
18
|
$esc =~ s{\n}{|n}g; |
65
|
7
|
|
|
|
|
13
|
$esc =~ s{\r}{|r}g; |
66
|
|
|
|
|
|
|
|
67
|
7
|
|
|
|
|
24
|
return $esc; |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
1; |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# ABSTRACT: Generate TeamCity build messages |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
__END__ |