360 lines
9.0 KiB
Perl
360 lines
9.0 KiB
Perl
package Mail::AuthenticationResults::FoldableHeader;
|
|
# ABSTRACT: Class for modelling a foldable header string
|
|
|
|
require 5.008;
|
|
use strict;
|
|
use warnings;
|
|
our $VERSION = '2.20231031'; # VERSION
|
|
use Carp;
|
|
|
|
use Mail::AuthenticationResults::Token::String;
|
|
use Mail::AuthenticationResults::Token::Space;
|
|
use Mail::AuthenticationResults::Token::Separator;
|
|
use Mail::AuthenticationResults::Token::Comment;
|
|
use Mail::AuthenticationResults::Token::Assignment;
|
|
|
|
|
|
sub new {
|
|
my ( $class, $args ) = @_;
|
|
|
|
my $self = {};
|
|
bless $self, $class;
|
|
|
|
$self->{ 'string' } = [];
|
|
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub eol {
|
|
my ( $self ) = @_;
|
|
return $self->{ 'eol' } if exists ( $self->{ 'eol' } );
|
|
return "\n";
|
|
}
|
|
|
|
|
|
sub set_eol {
|
|
my ( $self, $eol ) = @_;
|
|
$self->{ 'eol' } = $eol;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub indent {
|
|
my ( $self ) = @_;
|
|
return $self->{ 'indent' } if exists ( $self->{ 'indent' } );
|
|
return ' ';
|
|
}
|
|
|
|
|
|
sub set_indent {
|
|
my ( $self, $indent ) = @_;
|
|
$self->{ 'indent' } = $indent;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub sub_indent {
|
|
my ( $self ) = @_;
|
|
return $self->{ 'sub_indent' } if exists ( $self->{ 'sub_indent' } );
|
|
return ' ';
|
|
}
|
|
|
|
|
|
sub set_sub_indent {
|
|
my ( $self, $indent ) = @_;
|
|
$self->{ 'sub_indent' } = $indent;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub try_fold_at {
|
|
my ( $self ) = @_;
|
|
return $self->{ 'try_fold_at' } if exists ( $self->{ 'try_fold_at' } );
|
|
return 800;
|
|
}
|
|
|
|
|
|
sub set_try_fold_at {
|
|
my ( $self, $length ) = @_;
|
|
$self->{ 'try_fold_at' } = $length;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub force_fold_at {
|
|
my ( $self ) = @_;
|
|
return $self->{ 'force_fold_at' } if exists ( $self->{ 'force_fold_at' } );
|
|
return 900;
|
|
}
|
|
|
|
|
|
sub set_force_fold_at {
|
|
my ( $self, $length ) = @_;
|
|
$self->{ 'force_fold_at' } = $length;
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub string {
|
|
my( $self, $string ) = @_;
|
|
push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::String->new_from_value( $string );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub space {
|
|
my ( $self, $string ) = @_;
|
|
push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Space->new_from_value( $string );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub separator {
|
|
my ( $self, $string ) = @_;
|
|
push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Separator->new_from_value( $string );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub comment {
|
|
my ( $self, $string ) = @_;
|
|
push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Comment->new_from_value( $string );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub assignment {
|
|
my ( $self, $string ) = @_;
|
|
push @{ $self->{ 'string' } }, Mail::AuthenticationResults::Token::Assignment->new_from_value( $string );
|
|
return $self;
|
|
}
|
|
|
|
|
|
sub as_string {
|
|
my ( $self ) = @_;
|
|
|
|
my $string = q{};
|
|
my $string_length = 0;
|
|
my $content_added = 0;
|
|
|
|
my $sections = [];
|
|
my $stack = [];
|
|
my $last_type;
|
|
|
|
foreach my $part ( @{ $self->{ 'string' } } ) {
|
|
if ( $part->is() eq 'space' && $last_type ne 'space' ) {
|
|
# We have a folding space
|
|
push @$sections, $stack if @$stack;
|
|
$stack = [];
|
|
}
|
|
push @$stack, $part;
|
|
$last_type = $part->is();
|
|
}
|
|
push @$sections, $stack if @$stack;
|
|
|
|
my $eol = $self->eol();;
|
|
my $indent = $self->indent();
|
|
my $sub_indent = $self->sub_indent();
|
|
|
|
my $fold_length = 0;
|
|
SECTION:
|
|
while ( my $section = shift @$sections ) {
|
|
if ( $section->[0]->is() eq 'space' && $section->[0]->value() eq $eol ) {
|
|
# This section starts a new line
|
|
$fold_length = 0;
|
|
if ( ! exists( $section->[0]->{ '_folded' } ) ) {
|
|
if ( $section->[1]->is() eq 'space' ) {
|
|
# Take the last indent value for the fold indent
|
|
$indent = $section->[1]->value();
|
|
}
|
|
}
|
|
}
|
|
|
|
my $section_string = join( q{}, map { $_->value() } @$section );
|
|
my $section_length = length( $section_string );
|
|
|
|
if ( $fold_length + $section_length > $self->try_fold_at() ) {
|
|
if ( $fold_length > 0 ) {
|
|
# Remove whitespace tokens at beginning of section
|
|
while ( $section->[0]->is() eq 'space' ) {
|
|
shift @$section;
|
|
}
|
|
# Insert new folding whitespace at beginning of section
|
|
unshift @$section, Mail::AuthenticationResults::Token::Space->new_from_value( $indent . $sub_indent );
|
|
unshift @$section, Mail::AuthenticationResults::Token::Space->new_from_value( $eol );
|
|
$section->[0]->{ '_folded' } = 1;
|
|
unshift @$sections, $section;
|
|
next SECTION;
|
|
}
|
|
else {
|
|
# ToDo:
|
|
# This section alone is over the line limit
|
|
# It already starts with a fold, so we need to remove
|
|
# some of it to a new line if we can.
|
|
|
|
# Strategy 1: Fold at a relevant token boundary
|
|
my $first_section = [];
|
|
my $second_section = [];
|
|
push @$second_section, Mail::AuthenticationResults::Token::Space->new_from_value( $eol );
|
|
push @$second_section, Mail::AuthenticationResults::Token::Space->new_from_value( $indent . $sub_indent );
|
|
$second_section->[0]->{ '_folded' } = 1;
|
|
my $first_section_length = 0;
|
|
foreach my $part ( @$section ) {
|
|
my $part_length = length $part->value();
|
|
if ( $part_length + $first_section_length < $self->try_fold_at() ) {
|
|
push @$first_section, $part;
|
|
$first_section_length += $part_length;
|
|
}
|
|
else {
|
|
push @$second_section, $part;
|
|
$first_section_length = $self->try_fold_at() + 1; # everything from this point goes onto second
|
|
}
|
|
}
|
|
# Do we have a first and second section with actual content?
|
|
if ( ( grep { $_->is() ne 'space' } @$first_section ) &&
|
|
( grep { $_->is() ne 'space' } @$second_section ) ) {
|
|
unshift @$sections, $second_section;
|
|
unshift @$sections, $first_section;
|
|
next SECTION;
|
|
}
|
|
|
|
# We MUST fold at $self->force_fold_at();
|
|
# Strategy 2: Force fold at a space within a string
|
|
# Strategy 3: Force fold anywhere
|
|
|
|
# We assume that force fold is greater than try fold
|
|
}
|
|
}
|
|
|
|
$string .= $section_string;
|
|
$fold_length += $section_length;
|
|
}
|
|
|
|
return $string;
|
|
}
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=pod
|
|
|
|
=encoding UTF-8
|
|
|
|
=head1 NAME
|
|
|
|
Mail::AuthenticationResults::FoldableHeader - Class for modelling a foldable header string
|
|
|
|
=head1 VERSION
|
|
|
|
version 2.20231031
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
Class representing a foldable Authentication Results header string
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 new( $args )
|
|
|
|
Return a new instance of this class
|
|
|
|
=head2 eol()
|
|
|
|
Return the current eol marker.
|
|
|
|
=head2 set_eol( $eol )
|
|
|
|
Set the current eol marker.
|
|
|
|
=head2 indent()
|
|
|
|
Return the current base indent string.
|
|
|
|
Defaults to 4 spaces.
|
|
|
|
=head2 set_indent( $indent )
|
|
|
|
Set the current base indent string.
|
|
|
|
=head2 sub_indent()
|
|
|
|
Return the current fold indent string.
|
|
This is added to the current indent for folded headers.
|
|
|
|
Defaults to 2 spaces.
|
|
|
|
=head2 set_sub_indent( $indent )
|
|
|
|
Set the current fold indent string.
|
|
|
|
=head2 try_fold_at()
|
|
|
|
Return the length of header line for triggering a fold attempt
|
|
|
|
=head2 set_try_fold_at( $length )
|
|
|
|
Set the length of header line for triggering a fold attempt.
|
|
|
|
Defaults to 800.
|
|
|
|
=head2 force_fold_at()
|
|
|
|
Return the length of header line for forcing a fold.
|
|
|
|
=head2 set_force_fold_at( $length )
|
|
|
|
Set the length of header line for forcing a fold.
|
|
|
|
Defaults to 900.
|
|
|
|
=head2 string( $string )
|
|
|
|
Add $string to this header string
|
|
|
|
In this context, string can include a quoted string, or a string with assignment operators embedded within it.
|
|
A string is a unit of data which we do not want to break with a fold.
|
|
|
|
=head2 space( $string )
|
|
|
|
Add a space $string to this header string
|
|
|
|
In this context, a space can be a single space, multiple spaces, or a folding space.
|
|
A space is a unit of data which would be an ideal spot to insert a fold.
|
|
|
|
=head2 separator( $string )
|
|
|
|
Add a separator $string to this header string
|
|
|
|
In this context, a separator is the ; string or the / string.
|
|
|
|
=head2 comment( $string )
|
|
|
|
Add a comment $string to this header string
|
|
|
|
In this context, a comment is a comment string. A comment is a unit of data which we do not want to break with a fold.
|
|
|
|
=head2 assignment( $string )
|
|
|
|
Add an assignment $string to this header string
|
|
|
|
In this context, as assignment is the = string.
|
|
|
|
=head2 as_string()
|
|
|
|
Return the current header string
|
|
|
|
=head1 AUTHOR
|
|
|
|
Marc Bradshaw <marc@marcbradshaw.net>
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
This software is copyright (c) 2021 by Marc Bradshaw.
|
|
|
|
This is free software; you can redistribute it and/or modify it under
|
|
the same terms as the Perl 5 programming language system itself.
|
|
|
|
=cut
|