File Coverage

blib/lib/TeamCity/Message.pm
Criterion Covered Total %
statement 34 34 100.0
branch 5 8 62.5
condition 1 2 50.0
subroutine 7 7 100.0
pod 2 2 100.0
total 49 53 92.4


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__