← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:14 2021

Filename/usr/local/lib/perl5/site_perl/Mail/AuthenticationResults/Header/Comment.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sMail::AuthenticationResults::Header::Comment::::BEGIN@11Mail::AuthenticationResults::Header::Comment::BEGIN@11
0000s0sMail::AuthenticationResults::Header::Comment::::BEGIN@5Mail::AuthenticationResults::Header::Comment::BEGIN@5
0000s0sMail::AuthenticationResults::Header::Comment::::BEGIN@6Mail::AuthenticationResults::Header::Comment::BEGIN@6
0000s0sMail::AuthenticationResults::Header::Comment::::BEGIN@8Mail::AuthenticationResults::Header::Comment::BEGIN@8
0000s0sMail::AuthenticationResults::Header::Comment::::BEGIN@9Mail::AuthenticationResults::Header::Comment::BEGIN@9
0000s0sMail::AuthenticationResults::Header::Comment::::_HAS_VALUEMail::AuthenticationResults::Header::Comment::_HAS_VALUE
0000s0sMail::AuthenticationResults::Header::Comment::::build_stringMail::AuthenticationResults::Header::Comment::build_string
0000s0sMail::AuthenticationResults::Header::Comment::::safe_set_valueMail::AuthenticationResults::Header::Comment::safe_set_value
0000s0sMail::AuthenticationResults::Header::Comment::::set_valueMail::AuthenticationResults::Header::Comment::set_value
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Mail::AuthenticationResults::Header::Comment;
2# ABSTRACT: Class modelling Comment parts of the Authentication Results Header
3
4require 5.008;
5use strict;
6use warnings;
7our $VERSION = '2.20210112'; # VERSION
8use Scalar::Util qw{ weaken };
9use Carp;
10
11use base 'Mail::AuthenticationResults::Header::Base';
12
13
14sub _HAS_VALUE{ return 1; }
15
16sub safe_set_value {
17 my ( $self, $value ) = @_;
18
19 $value = q{} if ! defined $value;
20
21 $value =~ s/\t/ /g;
22 $value =~ s/\n/ /g;
23 $value =~ s/\r/ /g;
24
25 my $remain = $value;
26 my $depth = 0;
27 my $nested_ok = 1;
28 while ( length $remain > 0 ) {
29 my $first = substr( $remain,0,1 );
30 $remain = substr( $remain,1 );
31 $depth++ if $first eq '(';
32 $depth-- if $first eq ')';
33 $nested_ok = 0 if $depth == -1;
34 }
35 $nested_ok = 0 if $depth != 0;
36
37 # Remove parens if nested comments would be broken by them.
38 if ( ! $nested_ok ) {
39 $value =~ s/\(/ /g;
40 $value =~ s/\)/ /g;
41 }
42
43 $value =~ s/^\s+//;
44 $value =~ s/\s+$//;
45 #$value =~ s/;/ /g;
46
47 $self->set_value( $value );
48 return $self;
49}
50
51sub set_value {
52 my ( $self, $value ) = @_;
53
54 my $remain = $value;
55 my $depth = 0;
56 while ( length $remain > 0 ) {
57 my $first = substr( $remain,0,1 );
58 $remain = substr( $remain,1 );
59 $depth++ if $first eq '(';
60 $depth-- if $first eq ')';
61 croak 'Out of order parens in comment' if $depth == -1;
62 }
63 croak 'Mismatched parens in comment' if $depth != 0;
64 croak 'Invalid characters in value' if $value =~ /\n/;
65 croak 'Invalid characters in value' if $value =~ /\r/;
66
67 $self->{ 'value' } = $value;
68 return $self;
69}
70
71sub build_string {
72 my ( $self, $header ) = @_;
73 $header->comment( '(' . $self->value() . ')' );
74 return;
75}
76
771;
78
79__END__