File Coverage

lib/Mail/Make.pm
Criterion Covered Total %
statement 321 457 70.2
branch 132 246 53.6
condition 70 205 34.1
subroutine 34 52 65.3
pod 33 35 94.2
total 590 995 59.3


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## MIME Email Builder - ~/lib/Mail/Make.pm
3             ## Version v0.22.0
4             ## Copyright(c) 2026 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2026/03/02
7             ## Modified 2026/03/18
8             ## All rights reserved
9             ##
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package Mail::Make;
15             BEGIN
16             {
17 6     6   1121248 use strict;
  6         13  
  6         288  
18 6     6   29 use warnings;
  6         14  
  6         452  
19 6     6   52 warnings::register_categories( 'Mail::Make' );
20 6     6   917 use parent qw( Module::Generic );
  6         575  
  6         38  
21 6     6   715920 use vars qw( $VERSION $EXCEPTION_CLASS $CRLF $MAX_BODY_IN_MEMORY_SIZE );
  6         18  
  6         550  
22 6     6   4010 use Mail::Make::Entity;
  6         27  
  6         80  
23 6     6   1968 use Mail::Make::Exception;
  6         11  
  6         27  
24 6     6   1310 use Mail::Make::Headers;
  6         11  
  6         38  
25 6     6   1209 use Mail::Make::Headers::Subject;
  6         12  
  6         45  
26 6     6   1191 use Scalar::Util ();
  6         13  
  6         468  
27 6         12 our $CRLF = "\015\012";
28 6         11 our $MAX_BODY_IN_MEMORY_SIZE = 1_048_576; # 1 MiB default
29 6         11 our $EXCEPTION_CLASS = 'Mail::Make::Exception';
30 6         117 our $VERSION = 'v0.22.0';
31             }
32              
33 6     6   28 use strict;
  6         9  
  6         153  
34 6     6   23 use warnings;
  6         11  
  6         41856  
35              
36             sub init
37             {
38 49     49 1 2950961 my $self = shift( @_ );
39             # Top-level envelope headers live in a Mail::Make::Headers instance.
40             # All RFC 2822 envelope fields (From, To, Cc, Bcc, Subject, Date, Message-ID,
41             # In-Reply-To, References, Reply-To, Sender) are stored there directly, avoiding any
42             # duplication between Mail::Make and the final Mail::Make::Entity's headers object.
43 49         1120 $self->{_headers} = Mail::Make::Headers->new;
44             # Accumulated body parts (Mail::Make::Entity objects, in order of addition)
45 49         844 $self->{_parts} = [];
46             # When the serialised message exceeds this byte threshold (or when use_temp_file is true),
47             # as_string_ref() spools to a temporary file rather than keeping the entire message in RAM.
48             # Set to 0 or undef to disable file spooling entirely.
49 49         261 $self->{max_body_in_memory_size} = $MAX_BODY_IN_MEMORY_SIZE;
50 49         290 $self->{use_temp_file} = 0;
51 49         314 $self->{_exception_class} = $EXCEPTION_CLASS;
52 49         160 $self->{_init_strict_use_sub} = 1;
53 49 50       231 $self->SUPER::init( @_ ) || return( $self->pass_error );
54 49         4333 return( $self );
55             }
56              
57             # as_entity()
58             # Returns the fully assembled top-level Mail::Make::Entity object.
59             # The MIME structure is chosen based on the accumulated parts:
60             #
61             # Only plain text -> text/plain
62             # Only HTML -> text/html
63             # Plain + HTML -> multipart/alternative
64             # Any of the above + inlines -> multipart/related
65             # Any of the above + attachments -> multipart/mixed
66             sub as_entity
67             {
68 54     54 1 221 my $self = shift( @_ );
69              
70             # When gpg_sign() / gpg_encrypt() / gpg_sign_encrypt() have already assembled the
71             # top-level entity (stored in _gpg_entity), return it directly. Envelope headers have
72             # already been merged by _wrap_in_mail().
73 54 50       332 return( $self->{_gpg_entity} ) if( defined( $self->{_gpg_entity} ) );
74              
75             # S/MIME: entity pre-assembled by Mail::Make::SMIME::_build_from_smime_output().
76             # Headers are already embedded in the parsed entity; return it directly.
77 54 50       283 return( $self->{_smime_entity} ) if( defined( $self->{_smime_entity} ) );
78              
79             # Partition accumulated parts by role
80 54         149 my( @plain, @html, @inline, @attachment );
81 54         155 for my $part ( @{$self->{_parts}} )
  54         338  
82             {
83 75   50     472 my $type = lc( $part->effective_type // '' );
84             # Use get() for the raw string value; content_disposition() returns a typed
85             # object which stringifies to '' when uninitialised, making // unreliable.
86 75   100     430 my $cd = lc( $part->headers->get( 'Content-Disposition' ) // '' );
87 75 100 66     864 if( $type eq 'text/plain' && $cd !~ /attachment/ )
    100 66        
    100 66        
88             {
89 50         289 push( @plain, $part );
90             }
91             elsif( $type eq 'text/html' && $cd !~ /attachment/ )
92             {
93 9         29 push( @html, $part );
94             }
95             elsif( $cd =~ /inline/ && $part->headers->get( 'Content-ID' ) )
96             {
97 6         28 push( @inline, $part );
98             }
99             else
100             {
101 10         38 push( @attachment, $part );
102             }
103             }
104              
105             # NOTE: Step 1: build the text body (plain, html, or alternative)
106 54         109 my $body_entity;
107 54 100 100     1275 if( @plain && @html )
    100          
    100          
108             {
109 6   50     58 $body_entity = Mail::Make::Entity->build( type => 'multipart/alternative' ) ||
110             return( $self->pass_error( Mail::Make::Entity->error ) );
111 6         48185 $body_entity->add_part( $_ ) for( @plain );
112 6         33 $body_entity->add_part( $_ ) for( @html );
113             }
114             elsif( @html )
115             {
116 3         7 $body_entity = $html[0];
117             }
118             elsif( @plain )
119             {
120 44         108 $body_entity = $plain[0];
121             }
122             else
123             {
124 1         8 return( $self->error( "No body parts have been added." ) );
125             }
126              
127             # NOTE: Step 2: wrap in multipart/related if there are inline parts
128 53         110 my $related_entity = $body_entity;
129 53 100       252 if( @inline )
130             {
131 6   50     52 $related_entity = Mail::Make::Entity->build( type => 'multipart/related' ) ||
132             return( $self->pass_error( Mail::Make::Entity->error ) );
133 6         46953 $related_entity->add_part( $body_entity );
134 6         31 $related_entity->add_part( $_ ) for( @inline );
135             }
136              
137             # NOTE: Step 3: wrap in multipart/mixed if there are attachments
138 53         199 my $top_entity = $related_entity;
139 53 100       178 if( @attachment )
140             {
141 7   50     92 $top_entity = Mail::Make::Entity->build( type => 'multipart/mixed' ) ||
142             return( $self->pass_error( Mail::Make::Entity->error ) );
143 7         43951 $top_entity->add_part( $related_entity );
144 7         39 $top_entity->add_part( $_ ) for( @attachment );
145             }
146              
147             # NOTE: Step 4: transfer envelope headers to the top-level entity
148             # We merge our own _headers into the entity's headers object so that MIME-specific
149             # headers already set on the entity (Content-Type, CTE, etc.) take precedence, while
150             # envelope headers come from _headers.
151             # Any header already present in the entity headers is left untouched.
152 53         247 my $ent_headers = $top_entity->headers;
153              
154             # Auto-generate Date if not set
155             $self->{_headers}->init_header(
156 53         462 'Date' => $self->_format_date()
157             );
158              
159             # Auto-generate Message-ID if not set
160 53 100       290 unless( $self->{_headers}->exists( 'Message-ID' ) )
161             {
162             $self->{_headers}->message_id( { generate => 1, domain => $self->_default_domain } ) ||
163 45 50       463 return( $self->pass_error( $self->{_headers}->error ) );
164             }
165              
166             # MIME-Version is always added to the entity's own headers (not the envelope), since
167             # it belongs at the top of the MIME structure.
168 53         271 $ent_headers->init_header( 'MIME-Version' => '1.0' );
169              
170             # Merge envelope headers into the entity: each field from _headers that is not already
171             # present in ent_headers is copied over.
172             $self->{_headers}->scan( sub
173             {
174 269     269   480 my( $name, $value ) = @_;
175 269         816 $ent_headers->init_header( $name => $value );
176 269         548 return(1);
177 53         920 });
178              
179 53         400 return( $top_entity );
180             }
181              
182             # as_string()
183             # Assembles the message and returns it as a plain string, consistent with
184             # MIME::Entity::stringify. Use print($fh) to avoid loading the whole message into memory,
185             # or as_string_ref() to avoid a string copy.
186             sub as_string
187             {
188 26     26 1 8581 my $self = shift( @_ );
189 26   100     149 my $entity = $self->as_entity || return( $self->pass_error );
190 25         154 return( $entity->as_string( @_ ) );
191             }
192              
193             # as_string_ref()
194             # Returns the assembled message as a scalar reference (no string copy).
195             # When use_temp_file is true, or the serialised entity size exceeds max_body_in_memory_size,
196             # the message is written to a Module::Generic::Scalar buffer, thus keeping peak RAM use
197             # to a single copy rather than two overlapping buffers (the serialisation buffer plus the
198             # returned string).
199             sub as_string_ref
200             {
201 0     0 1 0 my $self = shift( @_ );
202 0   0     0 my $entity = $self->as_entity || return( $self->pass_error );
203 0         0 my $threshold = $self->{max_body_in_memory_size};
204 0         0 my $force_file = $self->{use_temp_file};
205              
206             # Fast path: build directly in memory when neither condition applies
207 0 0 0     0 unless( $force_file || ( defined( $threshold ) && $threshold > 0 && $entity->length > $threshold ) )
      0        
      0        
208             {
209 0         0 return( $entity->as_string_ref );
210             }
211              
212             # new_scalar() is inherited from Module::Generic, and returns a Module::Generic::Scalar object
213 0         0 my $buf = $self->new_scalar;
214             # In-memory fielhandle; returns a Module::Generic::Scalar::IO object
215 0   0     0 my $fh = $buf->open( '>', { binmode => ':raw', autoflush => 1 } ) || return( $buf->error );
216 0 0       0 $entity->print( $fh ) || return( $self->pass_error( $entity->error ) );
217             # The scalar object stringifies as necessary.
218 0         0 return( $buf );
219             }
220              
221             # attach( %opts )
222             # Adds a standard (downloadable) attachment.
223             # Recognised keys: path, data, type, filename, charset, encoding, description
224             sub attach
225             {
226 11     11 1 64 my $self = shift( @_ );
227             # Detect positional shorthand: attach( '/path/to/file.pdf' ) or
228             # attach( '/path/to/file.pdf', encoding => 'base64', ... )
229             # Triggered when argument count is odd and the first argument is a plain scalar
230             # (not a reference), contains no newline, and resolves to an existing file.
231 11 50 33     149 if( ( scalar( @_ ) % 2 ) &&
      66        
      33        
232             ( !ref( $_[0] ) || $self->_can_overload( $_[0] => '""' ) ) &&
233             index( "$_[0]", "\n" ) == -1 )
234             {
235             # shift() first to avoid $_[0] being altered by new_file() resolution
236 4         40 my $f = $self->new_file( shift( @_ ) ); # Module::Generic::File will trigger stringification
237 4 50       589272 if( $f->exists )
238             {
239             # then, we pass it back here:
240 4         378 unshift( @_, path => $f );
241             }
242             }
243 11         90 my $opts = $self->_get_args_as_hash( @_ );
244 11 100 66     13331 unless( defined( $opts->{data} ) || defined( $opts->{path} ) )
245             {
246 1         7 return( $self->error( "attach(): 'data' or 'path' is required." ) );
247             }
248 10   50     164 $opts->{disposition} //= 'attachment';
249 10   50     177 my $entity = Mail::Make::Entity->build( %$opts ) ||
250             return( $self->pass_error( Mail::Make::Entity->error ) );
251 10         67667 push( @{$self->{_parts}}, $entity );
  10         72  
252 10         221 return( $self );
253             }
254              
255             # attach_inline( %opts )
256             # Adds an inline part (e.g. an image referenced via cid: in HTML).
257             # 'id' or 'cid' is required.
258             sub attach_inline
259             {
260 7     7 1 58 my $self = shift( @_ );
261 7         54 my $opts = $self->_get_args_as_hash( @_ );
262 7 50 33     9176 unless( defined( $opts->{data} ) || defined( $opts->{path} ) )
263             {
264 0         0 return( $self->error( "attach_inline(): 'data' or 'path' is required." ) );
265             }
266 7 100 100     90 unless( defined( $opts->{id} ) || defined( $opts->{cid} ) )
267             {
268 1         23 return( $self->error( "attach_inline(): 'id' or 'cid' is required for inline parts." ) );
269             }
270             # Normalise: Entity->build() expects 'cid'
271 6   66     29 $opts->{cid} //= delete( $opts->{id} );
272 6   50     72 $opts->{disposition} //= 'inline';
273 6   50     52 my $entity = Mail::Make::Entity->build( %$opts ) ||
274             return( $self->pass_error( Mail::Make::Entity->error ) );
275 6         48043 push( @{$self->{_parts}}, $entity );
  6         37  
276 6         155 return( $self );
277             }
278              
279             # bcc( @addresses )
280             # Accumulates BCC recipients (may be called multiple times).
281             sub bcc
282             {
283 2     2 1 23 my $self = shift( @_ );
284 2 50       50 if( @_ )
285             {
286 2 50       48 my @encoded = map { $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ );
  2         35  
  0         0  
287             $self->{_headers}->push_header( 'Bcc' => join( ', ', @encoded ) ) ||
288 2 50       79 return( $self->pass_error( $self->{_headers}->error ) );
289 2         77 return( $self );
290             }
291 0         0 return( $self->{_headers}->header( 'Bcc' ) );
292             }
293              
294             # build( %params ) - alternate hash-based constructor/factory
295             # Returns a Mail::Make object with all parameters applied.
296             sub build
297             {
298 8     8 1 146821 my $class = shift( @_ );
299 8         63 my $params = $class->_get_args_as_hash( @_ );
300 8   50     30756 my $self = $class->new || return( $class->pass_error );
301              
302             # Scalar envelope fields
303 8         77 foreach my $field ( qw( date from in_reply_to message_id reply_to return_path sender subject ) )
304             {
305             $self->$field( $params->{ $field } ) || return( $self->pass_error )
306 64 100 50     243 if( exists( $params->{ $field } ) );
307             }
308             # List fields
309 8         34 foreach my $field ( qw( bcc cc references to ) )
310             {
311 32 100       59 if( exists( $params->{ $field } ) )
312             {
313 8         23 my $v = $params->{ $field };
314 8 100       42 $self->$field( ref( $v ) eq 'ARRAY' ? @$v : $v ) || return( $self->pass_error );
    50          
315             }
316             }
317             # Body convenience shorthands
318 8 50       30 if( exists( $params->{plain} ) )
319             {
320 8 50 33     32 if( exists( $params->{plain_opts} ) && ref( $params->{plain_opts} ) ne 'HASH' )
321             {
322 0   0     0 return( $self->error( "The parameter 'plain_opts' must be a hash reference. You provided '", $self->_str_val( $params->{plain_opts} // 'undef' ), "'." ) );
323             }
324 8   50     10 my %opts = %{$params->{plain_opts} // {}};
  8         70  
325 8 50       44 $self->plain( $params->{plain}, %opts ) || return( $self->pass_error );
326             }
327 8 50       48 if( exists( $params->{html} ) )
328             {
329 0 0 0     0 if( exists( $params->{html_opts} ) && ref( $params->{html_opts} ) ne 'HASH' )
330             {
331 0   0     0 return( $self->error( "The parameter 'html_opts' must be a hash reference. You provided '", $self->_str_val( $params->{html_opts} // 'undef' ), "'." ) );
332             }
333 0   0     0 my %opts = %{$params->{html_opts} // {}};
  0         0  
334 0 0       0 $self->html( $params->{html}, %opts ) || return( $self->pass_error );
335             }
336             # Attachments: scalar, arrayref of scalars, or arrayref of hashrefs
337 8 100 66     121 if( exists( $params->{attach} ) && defined( $params->{attach} ) )
338             {
339 4         13 my $attach = $params->{attach};
340             # Accepts vanilla array reference or array objects like Module::Generic::Array
341 4 100       43 my @items = $self->_is_array( $attach ) ? @$attach : ( $attach );
342 4         92 foreach my $item ( @items )
343             {
344 7 50       20341 next unless( defined( $item ) );
345             # Such as:
346             # { path => '/some/where/file.pdf', filename => '04 report.pdf', type => 'application/pdf' }
347             # { data => $attachment_data, filename => '04 report.pdf', type => 'application/pdf' }
348 7 100       53 if( ref( $item ) eq 'HASH' )
349             {
350 3 50       46 $self->attach( %$item ) || return( $self->pass_error );
351             }
352             else
353             {
354             # Plain scalar or stringifiable object - delegate to attach() which
355             # already handles the positional shorthand
356             # So, this can be an attachment data, or a file path, or a file object
357             # like Module::Generic::File (as long as it stringifies) and does not
358             # contain a "\n"
359 4 50       33 $self->attach( $item ) || return( $self->pass_error );
360             }
361             }
362             }
363             # Extra arbitrary headers
364 8 100 66     22688 if( exists( $params->{headers} ) && ref( $params->{headers} ) eq 'HASH' )
365             {
366 1         2 while( my( $n, $v ) = each( %{$params->{headers}} ) )
  2         8  
367             {
368 1 50       6 $self->header( $n, $v ) || return( $self->pass_error );
369             }
370             }
371 8         142 return( $self );
372             }
373              
374             # cc( @addresses )
375             # Accumulates CC recipients.
376             sub cc
377             {
378 3     3 1 40 my $self = shift( @_ );
379 3 50       57 if( @_ )
380             {
381 3 50       49 my @encoded = map { $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ );
  3         37  
  0         0  
382             $self->{_headers}->push_header( 'Cc' => join( ', ', @encoded ) ) ||
383 3 50       106 return( $self->pass_error( $self->{_headers}->error ) );
384 3         108 return( $self );
385             }
386 0         0 return( $self->{_headers}->header( 'Cc' ) );
387             }
388              
389             # date( [$date_string_or_epoch] )
390             # Delegates to Mail::Make::Headers::date(), which handles epoch integers, string validation,
391             # and RFC 5322 formatting.
392             sub date
393             {
394 0     0 1 0 my $self = shift( @_ );
395 0 0       0 if( @_ )
396             {
397             $self->{_headers}->date( @_ ) ||
398 0 0       0 return( $self->pass_error( $self->{_headers}->error ) );
399 0         0 return( $self );
400             }
401 0         0 return( $self->{_headers}->date );
402             }
403              
404             # from( [$address] )
405             sub from
406             {
407 47     47 1 120 my $self = shift( @_ );
408 47 50       213 if( @_ )
409             {
410 47         296 my $addr = $self->_encode_address( shift( @_ ) );
411             $self->{_headers}->set( 'From' => $addr ) ||
412 47 50       691 return( $self->pass_error( $self->{_headers}->error ) );
413 47         838 return( $self );
414             }
415 0         0 return( $self->{_headers}->header( 'From' ) );
416             }
417              
418             # header( $name, $value )
419             # Appends an arbitrary extra header to the envelope (push_header semantics: does not
420             # replace, allows multiple values for the same field).
421             sub header
422             {
423 2     2 1 7 my $self = shift( @_ );
424 2 50       9 if( @_ == 1 )
425             {
426             # Getter shortcut
427 0         0 return( $self->{_headers}->header( $_[0] ) );
428             }
429 2         6 my( $name, $value ) = @_;
430 2 50 33     28 unless( defined( $name ) && length( $name ) && defined( $value ) )
      33        
431             {
432 0         0 return( $self->error( "header(): name and value are required." ) );
433             }
434             $self->{_headers}->push_header( $name => $value ) ||
435 2 50       16 return( $self->pass_error( $self->{_headers}->error ) );
436 2         14 return( $self );
437             }
438              
439             # headers()
440             # Returns the Mail::Make::Headers object that holds the envelope headers.
441             # Read-only: the object is created in init() and is not replaceable from outside, to
442             # prevent accidental aliasing.
443 0     0 1 0 sub headers { return( $_[0]->{_headers} ); }
444              
445             # html( $content [, %opts] )
446             # Adds a text/html body part.
447             sub html
448             {
449 9     9 1 23 my $self = shift( @_ );
450 9         28 my $text = shift( @_ );
451 9         52 my $opts = $self->_get_args_as_hash( @_ );
452 9 50       70 unless( defined( $text ) )
453             {
454 0         0 return( $self->error( "html(): text content is required." ) );
455             }
456             my $part = Mail::Make::Entity->build(
457             type => 'text/html',
458             charset => ( $opts->{charset} // 'utf-8' ),
459 9   50     176 encoding => ( $opts->{encoding} // 'quoted-printable' ),
460             data => $text,
461             ) || return( $self->pass_error( Mail::Make::Entity->error ) );
462 9         61243 push( @{$self->{_parts}}, $part );
  9         43  
463 9         127 return( $self );
464             }
465              
466             # in_reply_to( [$mid] )
467             sub in_reply_to
468             {
469 0     0 1 0 my $self = shift( @_ );
470 0 0       0 if( @_ )
471             {
472             $self->{_headers}->set( 'In-Reply-To' => shift( @_ ) ) ||
473 0 0       0 return( $self->pass_error( $self->{_headers}->error ) );
474 0         0 return( $self );
475             }
476 0         0 return( $self->{_headers}->header( 'In-Reply-To' ) );
477             }
478              
479             # max_body_in_memory_size( [$bytes] )
480             # Gets or sets the byte threshold above which as_string_ref() spools to a temporary file.
481             # Set to 0 to disable the threshold (always use memory).
482             # Default: $Mail::Make::MAX_BODY_IN_MEMORY_SIZE (1 MiB).
483 0     0 1 0 sub max_body_in_memory_size { return( shift->_set_get_number( 'max_body_in_memory_size', @_ ) ); }
484              
485             # message_id( [$mid | \%opts] )
486             # Delegates fully to Mail::Make::Headers::message_id(), which handles generation,
487             # validation, and removal.
488             sub message_id
489             {
490 0     0 1 0 my $self = shift( @_ );
491 0 0       0 if( @_ )
492             {
493             $self->{_headers}->message_id( @_ ) ||
494 0 0       0 return( $self->pass_error( $self->{_headers}->error ) );
495 0         0 return( $self );
496             }
497 0         0 return( $self->{_headers}->message_id );
498             }
499              
500             # plain( $content [, %opts] )
501             # Adds a text/plain body part.
502             sub plain
503             {
504 43     43 1 1250 my $self = shift( @_ );
505 43         330 my $text = shift( @_ );
506 43         543 my $opts = $self->_get_args_as_hash( @_ );
507 43 50       481 unless( defined( $text ) )
508             {
509 0         0 return( $self->error( "plain(): text content is required." ) );
510             }
511             my $part = Mail::Make::Entity->build(
512             type => 'text/plain',
513             charset => ( $opts->{charset} // 'utf-8' ),
514 43   50     1363 encoding => ( $opts->{encoding} // 'quoted-printable' ),
515             data => $text,
516             ) || return( $self->pass_error( Mail::Make::Entity->error ) );
517 43         306414 push( @{$self->{_parts}}, $part );
  43         208  
518 43         353 return( $self );
519             }
520              
521             # print( $fh )
522             # Serialises the assembled message to a filehandle.
523             sub print
524             {
525 0     0 1 0 my $self = shift( @_ );
526 0   0     0 my $fh = shift( @_ ) ||
527             return( $self->error( "No file handle was provided to print the mail entity." ) );
528 0 0       0 unless( $self->_is_glob( $fh ) )
529             {
530 0   0     0 return( $self->error( "Value provided (", $self->_str_val( $fh // 'undef' ), ") is not a file handle." ) );
531             }
532 0   0     0 my $entity = $self->as_entity || return( $self->pass_error );
533 0 0       0 $entity->print( $fh ) || return( $self->pass_error( $entity->error ) );
534 0         0 return( $self );
535             }
536              
537             # references( @mids )
538             # Accumulates Message-ID references.
539             sub references
540             {
541 0     0 1 0 my $self = shift( @_ );
542 0 0       0 if( @_ )
543             {
544 0 0       0 my @mids = ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ );
  0         0  
545             # References is a single folded header: accumulate by appending.
546 0   0     0 my $existing = $self->{_headers}->header( 'References' ) // '';
547 0         0 my $new = join( ' ', grep{ length( $_ ) } $existing, @mids );
  0         0  
548             $self->{_headers}->set( 'References' => $new ) ||
549 0 0       0 return( $self->pass_error( $self->{_headers}->error ) );
550 0         0 return( $self );
551             }
552 0         0 return( $self->{_headers}->header( 'References' ) );
553             }
554              
555             # reply_to( [$address] )
556             sub reply_to
557             {
558 1     1 1 5 my $self = shift( @_ );
559 1 50       4 if( @_ )
560             {
561 1         3 my $addr = $self->_encode_address( shift( @_ ) );
562             $self->{_headers}->set( 'Reply-To' => $addr ) ||
563 1 50       3 return( $self->pass_error( $self->{_headers}->error ) );
564 1         10 return( $self );
565             }
566 0         0 return( $self->{_headers}->header( 'Reply-To' ) );
567             }
568              
569             # return_path( [$address] )
570             sub return_path
571             {
572 0     0 1 0 my $self = shift( @_ );
573 0 0       0 if( @_ )
574             {
575 0         0 my $addr = $self->_encode_address( shift( @_ ) );
576             $self->{_headers}->set( 'Return-Path' => $addr ) ||
577 0 0       0 return( $self->pass_error( $self->{_headers}->error ) );
578 0         0 return( $self );
579             }
580 0         0 return( $self->{_headers}->header( 'Return-Path' ) );
581             }
582              
583             # sender( [$address] )
584             sub sender
585             {
586 1     1 1 4 my $self = shift( @_ );
587 1 50       4 if( @_ )
588             {
589 1         8 my $addr = $self->_encode_address( shift( @_ ) );
590             $self->{_headers}->set( 'Sender' => $addr ) ||
591 1 50       7 return( $self->pass_error( $self->{_headers}->error ) );
592 1         4 return( $self );
593             }
594 0         0 return( $self->{_headers}->header( 'Sender' ) );
595             }
596              
597             # smtpsend( %opts )
598             # Assembles the message and submits it via SMTP using Net::SMTP.
599             #
600             # Recognised options:
601             # Host => $hostname_or_Net_SMTP_object
602             # Defaults to trying $ENV{SMTPHOSTS} (colon-separated),
603             # 'mailhost', then 'localhost'.
604             # MailFrom => $envelope_sender (MAIL FROM)
605             # Defaults to the From: header address-spec.
606             # To => \@recipients Override the To header for RCPT TO.
607             # Cc => \@recipients Additional CC addresses for RCPT TO.
608             # Bcc => \@recipients Additional BCC addresses for RCPT TO.
609             # Note: Bcc is stripped from the outgoing headers per RFC 2822 §3.6.3.
610             # Hello => $fqdn EHLO/HELO hostname.
611             # Port => $port SMTP port (default 25).
612             # Debug => $bool Enable Net::SMTP debug output.
613             #
614             # Returns the list of recipients successfully handed to the MTA on success, or undef and
615             # sets error() on failure.
616             sub smtpsend
617             {
618 12     12 1 498 my $self = shift( @_ );
619 12         74 my $opts = $self->_get_args_as_hash( @_ );
620              
621 12 50       15853 $self->_load_class( 'Net::SMTP' ) || return( $self->pass_error );
622              
623             # Build the entity first so we can inspect its headers
624 12   50     136666 my $entity = $self->as_entity || return( $self->pass_error );
625              
626             # Determine envelope sender (MAIL FROM)
627 12         33 my $mail_from = $opts->{MailFrom};
628 12 100 66     70 unless( defined( $mail_from ) && length( $mail_from ) )
629             {
630 11   50     40 my $from_hdr = $self->{_headers}->header( 'From' ) // '';
631 11 100       67 if( $from_hdr =~ /<([^>]+)>/ )
632             {
633 1         34 $mail_from = $1;
634             }
635             else
636             {
637 10         37 ( $mail_from = $from_hdr ) =~ s/\s+//g;
638             }
639             }
640              
641 12 50 33     181 unless( defined( $mail_from ) && length( $mail_from ) )
642             {
643 0         0 return( $self->error( "smtpsend(): cannot determine envelope sender (MAIL FROM). Set MailFrom or From header." ) );
644             }
645              
646             # Validate auth credentials before touching the network
647             # Password may be a plain string or a CODE ref (resolved later).
648 12         63 my $username = $opts->{Username};
649 12         25 my $password = $opts->{Password};
650              
651 12 100 66     47 if( defined( $username ) && length( $username ) )
652             {
653 2 100       6 unless( defined( $password ) )
654             {
655 1         15 return( $self->error( "smtpsend(): Username supplied but Password is missing." ) );
656             }
657              
658             # Authen::SASL and MIME::Base64 are required for SMTP AUTH.
659             # Check early so the error is clear rather than a cryptic auth failure.
660 1         27 foreach my $mod ( qw( MIME::Base64 Authen::SASL ) )
661             {
662 2 50       483 $self->_load_class( $mod ) ||
663             return( $self->error( "smtpsend(): SMTP authentication requires $mod, which is not installed. Install it with: cpan $mod" ) );
664             }
665             }
666              
667             # Determine RCPT TO addresses before connecting, so we can bail early.
668             # Honour explicit override lists first; fall back to message headers.
669 11         4977 my @rcpt_raw;
670 11         124 foreach my $field ( qw( To Cc Bcc ) )
671             {
672 33         79 my $v = $opts->{ $field };
673 33 100       70 if( defined( $v ) )
674             {
675 1 50       10 push( @rcpt_raw, ref( $v ) eq 'ARRAY' ? @$v : $v );
676             }
677             else
678             {
679 32   100     107 my $hv = $self->{_headers}->header( $field ) // '';
680 32 100       161 push( @rcpt_raw, $hv ) if( length( $hv ) );
681             }
682             }
683              
684             # Parse each raw value into bare addr-specs
685 11         20 my @addr;
686 11         24 foreach my $raw ( @rcpt_raw )
687             {
688 14         20 my @found_angle;
689 14         55 while( $raw =~ /<([^>]+)>/g )
690             {
691 0         0 push( @found_angle, $1 );
692             }
693 14 50       31 if( @found_angle )
694             {
695 0         0 push( @addr, @found_angle );
696             }
697             else
698             {
699             # Bare comma-separated list (no angle brackets)
700 14         66 push( @addr, grep{ /\@/ } map{ s/^\s+|\s+$//gr } split( /,/, $raw ) );
  13         113  
  13         231  
701             }
702             }
703             # Deduplicate while preserving order
704 11         20 my %seen;
705 11         24 @addr = grep{ !$seen{ $_ }++ } @addr;
  13         107  
706              
707 11 100       28 unless( @addr )
708             {
709 1         29 return( $self->error( "smtpsend(): no recipients found." ) );
710             }
711              
712             # Build Net::SMTP connection options
713             # SSL => 1 : direct SSL/TLS (e.g. port 465, aka SMTPS)
714 10         15 my @smtp_opts;
715 10 100       44 push( @smtp_opts, Hello => $opts->{Hello} ) if( defined( $opts->{Hello} ) );
716 10 100       39 push( @smtp_opts, Port => $opts->{Port} ) if( defined( $opts->{Port} ) );
717 10 50       29 push( @smtp_opts, Debug => $opts->{Debug} ) if( defined( $opts->{Debug} ) );
718 10 100       32 push( @smtp_opts, Timeout => $opts->{Timeout} ) if( defined( $opts->{Timeout} ) );
719 10 50       36 if( $opts->{SSL} )
720             {
721 0         0 push( @smtp_opts, SSL => 1 );
722 0 0       0 if( ref( $opts->{SSL_opts} ) eq 'HASH' )
723             {
724 0         0 push( @smtp_opts, %{$opts->{SSL_opts}} );
  0         0  
725             }
726             }
727              
728             # NOTE: SMTP connect
729 10         60 my $smtp;
730 10         16 my $quit = 1;
731 10         23 my $host = $opts->{Host};
732              
733 10 50       75 if( !defined( $host ) )
    100          
734             {
735 0         0 my @hosts = qw( mailhost localhost );
736 0 0 0     0 if( defined( $ENV{SMTPHOSTS} ) && length( $ENV{SMTPHOSTS} ) )
737             {
738 0         0 unshift( @hosts, split( /:/, $ENV{SMTPHOSTS} ) );
739             }
740              
741 0         0 foreach my $h ( @hosts )
742             {
743 0         0 local $@;
744 0         0 $smtp = eval{ Net::SMTP->new( $h, @smtp_opts ) };
  0         0  
745 0 0       0 last if( defined( $smtp ) );
746             }
747             }
748             elsif( $self->_is_a( $host => 'Net::SMTP' ) )
749             {
750             # Caller passes an already-connected object; we must not quit it.
751 1         219 $smtp = $host;
752 1         29 $quit = 0;
753             }
754             else
755             {
756 9         270 local $@;
757 9         20 $smtp = eval{ Net::SMTP->new( $host, @smtp_opts ) };
  9         431  
758             }
759              
760 10 100       34125 unless( defined( $smtp ) )
761             {
762 1         16 return( $self->error( "smtpsend(): could not connect to any SMTP server." ) );
763             }
764              
765             # STARTTLS upgrade (ignored when caller supplied a pre-built object or SSL)
766 9 50 33     52 if( $opts->{StartTLS} && $quit )
767             {
768 0         0 my %tls_opts;
769 0 0       0 if( ref( $opts->{SSL_opts} ) eq 'HASH' )
770             {
771 0         0 %tls_opts = %{$opts->{SSL_opts}};
  0         0  
772             }
773 0 0       0 unless( $smtp->starttls( %tls_opts ) )
774             {
775 0         0 my $smtp_msg = join( ' ', $smtp->message );
776 0         0 $smtp->quit;
777 0 0       0 return( $self->error( "smtpsend(): STARTTLS negotiation failed" . ( length( $smtp_msg ) ? ": $smtp_msg" : '.' ) ) );
778             }
779             }
780              
781             # -------------------------------------------------------------------------
782             # SMTP Authentication (SASL via Authen::SASL + Net::SMTP::auth)
783             # Password is resolved here so the CODE ref is called as late as possible.
784             #
785             # We build an explicit Authen::SASL object rather than letting Net::SMTP
786             # pick the mechanism freely. Left to itself, Authen::SASL prefers
787             # DIGEST-MD5 and CRAM-MD5, which are both deprecated (RFC 6331, RFC 8314) and
788             # routinely disabled on modern Postfix/Dovecot servers. Over an already
789             # encrypted STARTTLS or SSL channel, PLAIN and LOGIN are both safe and
790             # universally supported.
791             #
792             # Mechanism selection:
793             # 1. Caller may supply an explicit list via AuthMechanisms option.
794             # 2. Otherwise we use our preferred order: PLAIN LOGIN.
795             # 3. We intersect with what the server actually advertises (supports AUTH).
796             # -------------------------------------------------------------------------
797 9 100 66     74 if( defined( $username ) && length( $username ) )
798             {
799 1 50       25 if( ref( $password ) eq 'CODE' )
800             {
801 1         10 local $@;
802 1         9 $password = eval{ $password->() };
  1         38  
803 1 50 33     38 if( $@ || !defined( $password ) )
804             {
805 0 0       0 $smtp->quit if( $quit );
806 0   0     0 return( $self->error( "smtpsend(): password callback failed: " . ( $@ // 'returned undef' ) ) );
807             }
808             }
809              
810             # Determine which mechanisms the server advertises
811 1   50     12 my $server_mechs = $smtp->supports( 'AUTH' ) // '';
812              
813             # Build the preferred mechanism list
814 1   50     19 my $preferred = $opts->{AuthMechanisms} // 'PLAIN LOGIN';
815              
816             # Intersect: keep only those the server supports, preserving our order
817 1         4 my %server_set = map{ uc( $_ ) => 1 } split( /\s+/, $server_mechs );
  0         0  
818 1         2 my @agreed = grep{ $server_set{ uc( $_ ) } } split( /\s+/, $preferred );
  2         367  
819              
820 1 50       60 if( !@agreed )
821             {
822             # No intersection -- fall back to whatever the server offers,
823             # excluding the deprecated challenge-response mechanisms.
824 1         5 @agreed = grep{ !/^(?:DIGEST-MD5|CRAM-MD5|GSSAPI)$/i }
  0         0  
825             split( /\s+/, $server_mechs );
826             }
827              
828 1         27 my $sasl = Authen::SASL->new(
829             mechanism => join( ' ', @agreed ),
830             callback => {
831             user => $username,
832             pass => $password,
833             authname => $username,
834             },
835             );
836              
837 1 50       45 unless( $smtp->auth( $sasl ) )
838             {
839             # Capture the server's error message for a more useful diagnostic
840 1         44 my $smtp_msg = join( ' ', $smtp->message );
841 1 50       13 $smtp->quit if( $quit );
842 1 50       433 return( $self->error( "smtpsend(): SMTP authentication failed for user '$username'" . ( length( $smtp_msg ) ? ": $smtp_msg" : '.' ) ) );
843             }
844             }
845              
846             # Serialise message, stripping Bcc from transmitted copy
847             my $send_entity = $self->as_entity || do
848 8   33     52 {
849             $smtp->quit if( $quit );
850             return( $self->pass_error );
851             };
852 8         49 $send_entity->headers->remove( 'Bcc' );
853             my $msg = $send_entity->as_string || do
854 8   33     169 {
855             $smtp->quit if( $quit );
856             return( $self->pass_error( $send_entity->error ) );
857             };
858              
859             # Submit
860 8   33     268 my $ok = $smtp->mail( $mail_from )
861             && $smtp->to( @addr )
862             && $smtp->data( $msg );
863              
864 8 100       350990 $smtp->quit if( $quit );
865              
866 8 50       13197 unless( $ok )
867             {
868 0         0 return( $self->error( "smtpsend(): SMTP transaction failed." ) );
869             }
870              
871 8 50       259 return( wantarray() ? @addr : \@addr );
872             }
873              
874             # subject( [$string] )
875             # RFC 2047-encodes non-ASCII subjects before storing.
876             sub subject
877             {
878 39     39 1 1237 my $self = shift( @_ );
879 39 50       120 if( @_ )
880             {
881 39         190 my $enc = $self->_encode_header( shift( @_ ) );
882             $self->{_headers}->set( 'Subject' => $enc ) ||
883 39 50       38620 return( $self->pass_error( $self->{_headers}->error ) );
884 39         526 return( $self );
885             }
886 0         0 return( $self->{_headers}->header( 'Subject' ) );
887             }
888              
889             # to( @addresses )
890             # Accumulates To recipients.
891             sub to
892             {
893 48     48 1 1261 my $self = shift( @_ );
894 48 50       130 if( @_ )
895             {
896 48 50       266 my @encoded = map{ $self->_encode_address( $_ ) } ( ref( $_[0] ) eq 'ARRAY' ? @{$_[0]} : @_ );
  49         145  
  0         0  
897             # Merge into a single To: header (RFC 5322 §3.6.3 allows only one To field)
898 48         498 my $existing = $self->{_headers}->header( 'To' );
899 48 100       128 my $new_val = join( ', ', grep{ defined( $_ ) && length( $_ ) } $existing, @encoded );
  97         661  
900             $self->{_headers}->set( 'To' => $new_val ) ||
901 48 50       221 return( $self->pass_error( $self->{_headers}->error ) );
902 48         568 return( $self );
903             }
904 0         0 return( $self->{_headers}->header( 'To' ) );
905             }
906              
907             # use_temp_file( [$bool] )
908             # When true, as_string_ref() always spools to a temporary file regardless of message size.
909             # This is used when we know the message will be large, or when we want to bound peak
910             # memory use unconditionally.
911             # Default: false.
912 0     0 1 0 sub use_temp_file { return( shift->_set_get_boolean( 'use_temp_file', @_ ) ); }
913              
914             # gpg_encrypt( %opts )
915             # Encrypts this message for one or more recipients and returns a new Mail::Make object
916             # whose body is a RFC 3156 multipart/encrypted structure.
917             #
918             # Required options:
919             # Recipients => [ 'alice@example.com', ... ]
920             #
921             # Optional options:
922             # GpgBin => '/usr/bin/gpg2'
923             # KeyServer => 'keys.openpgp.org'
924             # AutoFetch => 1
925             # Digest => 'SHA256'
926             sub gpg_encrypt
927             {
928 0     0 1 0 my $self = shift( @_ );
929 0         0 my $opts = $self->_get_args_as_hash( @_ );
930 0         0 require Mail::Make::GPG;
931             my $gpg = Mail::Make::GPG->new(
932             ( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
933             ( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
934             ( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ),
935 0   0     0 ( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ),
936             ) || return( $self->pass_error( Mail::Make::GPG->error ) );
937              
938             my $recipients = $opts->{Recipients} ||
939 0   0     0 return( $self->error( 'gpg_encrypt(): Recipients option is required.' ) );
940 0 0       0 $recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' );
941              
942 0   0     0 return( $gpg->encrypt(
943             entity => $self,
944             recipients => $recipients,
945             ) || $self->pass_error( $gpg->error ) );
946             }
947              
948             # gpg_sign( %opts )
949             # Signs this message and returns a new Mail::Make object whose body is a
950             # RFC 3156 multipart/signed structure with a detached ASCII-armoured signature.
951             #
952             # Required options:
953             # KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752'
954             #
955             # Optional options:
956             # Passphrase => 'secret' # or CODE ref; omit to use gpg-agent
957             # Digest => 'SHA256'
958             # GpgBin => '/usr/bin/gpg2'
959             sub gpg_sign
960             {
961 0     0 1 0 my $self = shift( @_ );
962 0         0 my $opts = $self->_get_args_as_hash( @_ );
963 0         0 require Mail::Make::GPG;
964             my $gpg = Mail::Make::GPG->new(
965             ( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
966 0   0     0 ( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
967             ) || return( $self->pass_error( Mail::Make::GPG->error ) );
968              
969             return( $gpg->sign(
970             entity => $self,
971             key_id => ( $opts->{KeyId} // '' ),
972             passphrase => ( $opts->{Passphrase} // undef ),
973 0   0     0 ( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
974             ) || $self->pass_error( $gpg->error ) );
975             }
976              
977             # gpg_sign_encrypt( %opts )
978             # Signs then encrypts this message. Returns a new Mail::Make object whose body is a
979             # RFC 3156 multipart/encrypted structure containing a signed and encrypted payload.
980             #
981             # Required options:
982             # KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752'
983             # Recipients => [ 'alice@example.com', ... ]
984             #
985             # Optional options:
986             # Passphrase => 'secret' # or CODE ref
987             # Digest => 'SHA256'
988             # GpgBin => '/usr/bin/gpg2'
989             # KeyServer => 'keys.openpgp.org'
990             # AutoFetch => 1
991             sub gpg_sign_encrypt
992             {
993 0     0 1 0 my $self = shift( @_ );
994 0         0 my $opts = $self->_get_args_as_hash( @_ );
995 0         0 require Mail::Make::GPG;
996             my $gpg = Mail::Make::GPG->new(
997             ( defined( $opts->{GpgBin} ) ? ( gpg_bin => $opts->{GpgBin} ) : () ),
998             ( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
999             ( defined( $opts->{KeyServer} ) ? ( keyserver => $opts->{KeyServer} ) : () ),
1000 0   0     0 ( defined( $opts->{AutoFetch} ) ? ( auto_fetch => $opts->{AutoFetch} ) : () ),
1001             ) || return( $self->pass_error( Mail::Make::GPG->error ) );
1002              
1003             my $recipients = $opts->{Recipients} ||
1004 0   0     0 return( $self->error( 'gpg_sign_encrypt(): Recipients option is required.' ) );
1005 0 0       0 $recipients = [ $recipients ] unless( ref( $recipients ) eq 'ARRAY' );
1006              
1007             return( $gpg->sign_encrypt(
1008             entity => $self,
1009             key_id => ( $opts->{KeyId} // '' ),
1010             passphrase => ( $opts->{Passphrase} // undef ),
1011             recipients => $recipients,
1012 0   0     0 ( defined( $opts->{Digest} ) ? ( digest => $opts->{Digest} ) : () ),
1013             ) || $self->pass_error( $gpg->error ) );
1014             }
1015              
1016              
1017             # smime_encrypt( %opts )
1018             # Encrypts this message for one or more recipients. Returns a new Mail::Make object whose
1019             # entity is a RFC 5751 application/pkcs7-mime enveloped message.
1020             #
1021             # Required options:
1022             # RecipientCert => $pem_string_or_path (or arrayref of either)
1023             #
1024             # Optional options:
1025             # CACert => $pem_string_or_path
1026             sub smime_encrypt
1027             {
1028 0     0 1 0 my $self = shift( @_ );
1029 0         0 my $opts = $self->_get_args_as_hash( @_ );
1030 0         0 require Mail::Make::SMIME;
1031             my $smime = Mail::Make::SMIME->new(
1032 0   0     0 ( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ),
1033             ) || return( $self->pass_error( Mail::Make::SMIME->error ) );
1034              
1035             return( $smime->encrypt(
1036             entity => $self,
1037 0   0     0 RecipientCert => ( $opts->{RecipientCert} || return( $self->error( 'smime_encrypt(): RecipientCert option is required.' ) ) ),
1038             ) || $self->pass_error( $smime->error ) );
1039             }
1040              
1041             # smime_sign( %opts )
1042             # Signs this message and returns a new Mail::Make object whose entity is a RFC 5751
1043             # multipart/signed structure with a detached S/MIME signature.
1044             #
1045             # Required options:
1046             # Cert => $pem_string_or_path
1047             # Key => $pem_string_or_path
1048             #
1049             # Optional options:
1050             # KeyPassword => $string_or_coderef
1051             # CACert => $pem_string_or_path
1052             sub smime_sign
1053             {
1054 0     0 1 0 my $self = shift( @_ );
1055 0         0 my $opts = $self->_get_args_as_hash( @_ );
1056 0         0 require Mail::Make::SMIME;
1057             my $smime = Mail::Make::SMIME->new(
1058             ( defined( $opts->{Cert} ) ? ( cert => $opts->{Cert} ) : () ),
1059             ( defined( $opts->{Key} ) ? ( key => $opts->{Key} ) : () ),
1060             ( defined( $opts->{KeyPassword} ) ? ( key_password => $opts->{KeyPassword} ) : () ),
1061 0   0     0 ( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ),
1062             ) || return( $self->pass_error( Mail::Make::SMIME->error ) );
1063              
1064 0   0     0 return( $smime->sign(
1065             entity => $self,
1066             ) || $self->pass_error( $smime->error ) );
1067             }
1068              
1069             # smime_sign_encrypt( %opts )
1070             # Signs then encrypts this message. Returns a new Mail::Make object whose entity is a
1071             # RFC 5751 enveloped message containing a signed payload.
1072             #
1073             # Required options:
1074             # Cert => $pem_string_or_path
1075             # Key => $pem_string_or_path
1076             # RecipientCert => $pem_string_or_path (or arrayref of either)
1077             #
1078             # Optional options:
1079             # KeyPassword => $string_or_coderef
1080             # CACert => $pem_string_or_path
1081             sub smime_sign_encrypt
1082             {
1083 0     0 1 0 my $self = shift( @_ );
1084 0         0 my $opts = $self->_get_args_as_hash( @_ );
1085 0         0 require Mail::Make::SMIME;
1086             my $smime = Mail::Make::SMIME->new(
1087             ( defined( $opts->{Cert} ) ? ( cert => $opts->{Cert} ) : () ),
1088             ( defined( $opts->{Key} ) ? ( key => $opts->{Key} ) : () ),
1089             ( defined( $opts->{KeyPassword} ) ? ( key_password => $opts->{KeyPassword} ) : () ),
1090 0   0     0 ( defined( $opts->{CACert} ) ? ( ca_cert => $opts->{CACert} ) : () ),
1091             ) || return( $self->pass_error( Mail::Make::SMIME->error ) );
1092              
1093             return( $smime->sign_encrypt(
1094             entity => $self,
1095             RecipientCert => ( $opts->{RecipientCert} ||
1096 0   0     0 return( $self->error( 'smime_sign_encrypt(): RecipientCert option is required.' ) ) ),
1097             ) || $self->pass_error( $smime->error ) );
1098             }
1099              
1100             # _default_domain()
1101             # Returns a reasonable FQDN for auto-generating Message-IDs.
1102             # Uses Sys::Hostname (core) and falls back to 'mail.make.local'.
1103             sub _default_domain
1104             {
1105 45     45   108 my $self = shift( @_ );
1106 45         70 local $@;
1107             my $host = eval
1108 45         146 {
1109 45         3239 require Sys::Hostname;
1110 45         6421 Sys::Hostname::hostname();
1111             };
1112 45 50 33     870 return( 'mail.make.local' ) if( $@ || !defined( $host ) || !length( $host ) );
      33        
1113             # If it is not a FQDN (no dot), append .local to avoid rejection by
1114             # Mail::Make::Headers::_generate_message_id
1115 45 50       287 $host .= '.local' if( index( $host, '.' ) == -1 );
1116 45         730 return( $host );
1117             }
1118              
1119             # _encode_address( $addr_string )
1120             # Encodes the display name portion of an RFC 2822 address using RFC 2047 when it contains
1121             # non-ASCII characters. The addr-spec (the part inside angle brackets) is never altered.
1122             #
1123             # Recognised forms:
1124             # "Display Name" <local@domain>
1125             # Display Name <local@domain>
1126             # local@domain (bare addr-spec, passed through unchanged)
1127             #
1128             # Returns the wire-safe string.
1129             sub _encode_address
1130             {
1131 103     103   568 my( $self, $addr ) = @_;
1132 103 50 33     644 return( $addr ) unless( defined( $addr ) && length( $addr ) );
1133 103 100       644 if( $addr =~ /^("?)([^<"]+)\1\s*<([^>]+)>\s*$/ )
1134             {
1135 7         188 my( $name, $spec ) = ( $2, $3 );
1136 7         161 $name =~ s/^\s+|\s+$//g;
1137 7         121 my $enc = $self->_encode_header( $name );
1138             # If the name was encoded (contains non-ASCII), the encoded-word is
1139             # self-quoting and must NOT be surrounded by double-quotes.
1140             # If it is plain ASCII, keep surrounding quotes for correct parsing.
1141 7 100       8060 return( $enc ne $name
1142             ? "${enc} <${spec}>"
1143             : qq{"${name}" <${spec}>} );
1144             }
1145             # Bare addr-spec - nothing to encode
1146 96         367 return( $addr );
1147             }
1148              
1149             # _encode_header( $string )
1150             # Encodes a header value for the wire using RFC 2047 if necessary.
1151             # Delegates to Mail::Make::Headers::Subject which handles fragmentation, fold points,
1152             # and UTF-8 boundary safety.
1153             sub _encode_header
1154             {
1155 46     46   262 my( $self, $str ) = @_;
1156 46 50       187 return( $str ) unless( defined( $str ) );
1157 46         688 my $s = Mail::Make::Headers::Subject->new;
1158 46         520 $s->value( $str );
1159 46         313 return( $s->as_string );
1160             }
1161              
1162             # _format_date()
1163             # Returns the current date/time in RFC 2822 format.
1164             sub _format_date
1165             {
1166 53     53   2637 my @t = localtime( time );
1167 53         1016 my @day = qw( Sun Mon Tue Wed Thu Fri Sat );
1168 53         712 my @mon = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
1169             my $tz = do
1170 53         116 {
1171 53         798 my @lt = localtime( time );
1172 53         321 my @gt = gmtime( time );
1173 53         192 my $diff = ( $lt[2] - $gt[2] ) * 60 + ( $lt[1] - $gt[1] );
1174 53 50 33     697 $diff += 1440 if( $lt[5] > $gt[5] || ( $lt[5] == $gt[5] && $lt[7] > $gt[7] ) );
      33        
1175 53 50 33     816 $diff -= 1440 if( $lt[5] < $gt[5] || ( $lt[5] == $gt[5] && $lt[7] < $gt[7] ) );
      33        
1176 53 50       231 my $sign = $diff >= 0 ? '+' : '-';
1177 53         114 $diff = abs( $diff );
1178 53         566 sprintf( '%s%02d%02d', $sign, int( $diff / 60 ), $diff % 60 );
1179             };
1180 53         1249 return( sprintf( '%s, %02d %s %04d %02d:%02d:%02d %s',
1181             $day[ $t[6] ], $t[3], $mon[ $t[4] ], $t[5] + 1900,
1182             $t[2], $t[1], $t[0], $tz ) );
1183             }
1184              
1185             # NOTE: STORABLE support
1186 0     0 0   sub STORABLE_freeze { CORE::return( CORE::shift->FREEZE( @_ ) ); }
1187              
1188 0     0 0   sub STORABLE_thaw { CORE::return( CORE::shift->THAW( @_ ) ); }
1189              
1190             1;
1191             # NOTE: POD
1192             __END__
1193              
1194             =encoding utf-8
1195              
1196             =head1 NAME
1197              
1198             Mail::Make - Strict, Fluent MIME Email Builder
1199              
1200             =head1 SYNOPSIS
1201              
1202             use Mail::Make;
1203              
1204             # Fluent API
1205             my $mail = Mail::Make->new
1206             ->from( 'hello@example.com' )
1207             ->to( 'jack@example.jp' )
1208             ->subject( "Q4 Report - Yamato, Inc." )
1209             ->plain( "Please find the report attached." )
1210             ->html( '<p>Please find the report <b>attached</b>.</p>' )
1211             ->attach_inline(
1212             path => '/var/www/images/Yamato,Inc-Logo.png',
1213             type => 'image/png',
1214             cid => 'logo@yamato-inc',
1215             )
1216             # Positional shorthand - path, type, and filename are auto-detected
1217             ->attach( '/path/to/report.pdf' )
1218            
1219             # Explicit form - override type and filename
1220             ->attach(
1221             path => '/tmp/Q4-Report.pdf',
1222             type => 'application/pdf',
1223             filename => 'Q4 Report 2025.pdf',
1224             );
1225              
1226             my $raw = $mail->as_string || die( $mail->error );
1227             print $raw;
1228              
1229             # Scalar-ref form - no string copy, useful for large messages
1230             my $raw_ref = $mail->as_string_ref || die( $mail->error );
1231             print $$raw_ref;
1232              
1233             # Write directly to a filehandle - no in-memory buffering
1234             open( my $fh, '>', '/tmp/message.eml' ) or die $!;
1235             $mail->print( $fh ) || die( $mail->error );
1236              
1237             # Send directly
1238             $mail->smtpsend( Host => 'smtp.example.com' )
1239             || die( $mail->error );
1240              
1241             # Direct access to the envelope headers object
1242             my $h = $mail->headers;
1243             $h->set( 'X-Priority' => '1' );
1244              
1245             # Hash-based alternative constructor
1246             my $mail2 = Mail::Make->build(
1247             from => 'hello@example.com',
1248             to => [ 'jack@example.jp' ],
1249             subject => 'Hello',
1250             plain => "Hi there.\n",
1251             html => '<p>Hi there.</p>',
1252             ) || die( Mail::Make->error );
1253              
1254             =head1 VERSION
1255              
1256             v0.22.0
1257              
1258             =head1 DESCRIPTION
1259              
1260             C<Mail::Make> is a strict, validating MIME email builder with a fluent interface.
1261              
1262             All RFC 2822 envelope fields (C<From>, C<To>, C<Cc>, C<Bcc>, C<Subject>, C<Date>, C<Message-ID>, C<In-Reply-To>, C<References>, C<Reply-To>, C<Sender>) are stored in a L<Mail::Make::Headers> instance accessible via L</headers>, eliminating any duplication between C<Mail::Make>'s own fields and the final entity's headers.
1263              
1264             The MIME structure is assembled lazily when L</as_entity>, L</as_string>, or L</print> is called. Structure selection is automatic:
1265              
1266             =over 4
1267              
1268             =item * plain only → C<text/plain>
1269              
1270             =item * html only → C<text/html>
1271              
1272             =item * plain + html → C<multipart/alternative>
1273              
1274             =item * above + inline parts → wrapped in C<multipart/related>
1275              
1276             =item * above + attachments → wrapped in C<multipart/mixed>
1277              
1278             =back
1279              
1280             Non-ASCII display names in address fields and non-ASCII subjects are RFC 2047 encoded automatically.
1281              
1282             L</as_string> returns a plain string, consistent with C<MIME::Entity::stringify>.
1283              
1284             L</as_string_ref> returns a B<scalar reference> to avoid a string copy, useful for large messages. L</print> writes directly to a filehandle without buffering the message in memory at all, and is the recommended approach for very large messages.
1285              
1286             When L</use_temp_file> is set, or the assembled message size would exceed L</max_body_in_memory_size>, L</as_string_ref> spools to a temporary file during serialisation and reads it back, keeping peak memory use to a single copy rather than two overlapping buffers.
1287              
1288             =head1 CONSTRUCTOR
1289              
1290             =head2 new( [%opts] )
1291              
1292             Creates a new C<Mail::Make> object. Takes an hash or hash reference of options. Supported options are:
1293              
1294             =over 4
1295              
1296             =item * C<max_body_in_memory_size>
1297              
1298             Sets the byte threshold above which L</as_string_ref> spools to a temporary file rather than building the message in RAM. Set to C<0> or C<undef> to disable the threshold entirely. Default: C<$Mail::Make::MAX_BODY_IN_MEMORY_SIZE> (1 MiB).
1299              
1300             =item * C<use_temp_file>
1301              
1302             When true, L</as_string_ref> always spools to a temporary file regardless of message size. Useful when you know the message will be large, or when you want to bound peak memory use unconditionally. Default: false.
1303              
1304             =back
1305              
1306             =head2 build( %params )
1307              
1308             An alternate hash-based constructor.
1309              
1310             Takes an hash or hash reference of options.
1311              
1312             Recognised parameters are: L<from|/from>, L<to|/to>, L<cc|/cc>, L<bcc|/bcc>, L<date|/date>, L<reply_to|/reply_to>, L<sender|/sender>, L<subject|/subject>, L<in_reply_to|/in_reply_to>, L<message_id|/message_id>, L<references|/references>, L<plain|/plain>, L<html|/html>, C<plain_opts>, C<html_opts>, C<attach>, C<headers>.
1313              
1314             When using the standard mail envelop headers, C<build> will call each respective method, such as L<from|/from>, L<to|/to>, etc.
1315              
1316             When passing the C<plain> parameter, it will call L<plain|/plain>, and passing it the optional hash reference of parameters provided with C<plain_opts>
1317              
1318             Likewise when passing the C<html> parameter, it will call L<html|/html>, and passing it the optional hash reference of parameters provided with C<html_opts>
1319              
1320             The C<attach> parameter accepts one of the following forms:
1321              
1322             =over 4
1323              
1324             =item * A plain scalar or stringifiable object resolving to an existing file; C<path>, C<type>, and C<filename> are auto-detected:
1325              
1326             attach => 'report.pdf'
1327              
1328             =item * An array reference of plain scalars for multiple attachments; likewise C<path>, C<type>, and C<filename> are auto-detected:
1329              
1330             attach => [ 'report.pdf', 'log.pdf' ]
1331              
1332             =item * An array reference of hash references for full control over each attachment:
1333              
1334             attach => [
1335             { path => 'report.pdf', filename => 'Q4 Report.pdf' },
1336             { path => 'log.pdf', filename => 'Access Log.pdf' },
1337             ]
1338              
1339             =item * A mix of both forms is also accepted:
1340              
1341             attach => [ 'report.pdf', { path => 'log.pdf', filename => 'Access Log.pdf' } ]
1342              
1343             =back
1344              
1345             If C<type> is not provided in any of the above forms, it is auto-detected from the file content using L<Module::Generic::File::Magic>.
1346              
1347             Each element is forwarded to L</attach>, so all options supported by L</attach> are available in the hash reference form.
1348              
1349             You can also provide additional mail envelop headers by providing the parameter C<headers> as an hash reference.
1350              
1351             For each element of that hash reference, it will call L<header/header>
1352              
1353             Returns the populated C<Mail::Make> object, or upon error, set an L<error object|Mail::Make::Exception>, and returns C<undef> in scalar context or an empty list in list context.
1354              
1355             =head1 FLUENT METHODS
1356              
1357             All setter methods return C<$self> to allow chaining. Called without arguments, they act as getters and return the stored value (delegating to the internal L<Mail::Make::Headers> object).
1358              
1359             =head2 attach( %opts )
1360              
1361             # Positional shorthand: path, type, and filename are auto-detected
1362             $mail->attach( '/path/to/report.pdf' );
1363              
1364             # Explicit form
1365             $mail->attach(
1366             path => $pdf_path,
1367             type => 'application/pdf',
1368             filename => 'report.pdf',
1369             ); # returns $mail
1370              
1371             Adds a downloadable attachment, and returns the current instance for chaining.
1372              
1373             Takes either a single positional file path as a shorthand, or an hash or hash reference of parameters.
1374              
1375             When a single plain scalar or stringifiable object is provided and it resolves to an existing file on disk, C<path>, C<type>, and C<filename> are set automatically. Additional named options may still be passed after the path:
1376              
1377             $mail->attach( '/path/to/report.pdf', encoding => 'base64' );
1378              
1379             Requires either C<path> or C<data> when using the named-parameter form.
1380              
1381             Options are:
1382              
1383             =over 4
1384              
1385             =item * C<charset>
1386              
1387             The optional charset of the attachment.
1388              
1389             =item * C<description>
1390              
1391             A short description.
1392              
1393             =item * C<encoding>
1394              
1395             The encoding of the attachment, such as C<zip>, C<gzip>, C<bzip2>, etc..
1396              
1397             =item * C<filename>
1398              
1399             The attachment filename as displayed to the reader.
1400              
1401             =item * C<type>
1402              
1403             The attachment mime-type.
1404              
1405             =back
1406              
1407             All parameters are forwarded to L<Mail::Make::Entity/build>.
1408              
1409             =head2 attach_inline( %opts )
1410              
1411             $mail->attach_inline(
1412             path => $img_path,
1413             type => 'image/png',
1414             filename => 'Yamato,Inc-Logo.png',
1415             cid => 'logo@yamato-inc',
1416             ); # returns $mail
1417              
1418             Adds an inline part (e.g. an embedded image referenced via C<cid:> in HTML), and returns the current instance for chaining.
1419              
1420             Takes an hash or hash reference of parameters.
1421              
1422             Requires either <path> or C<data> and either C<id> or C<cid>.
1423              
1424             Supported parameters are:
1425              
1426             =over 4
1427              
1428             =item * C<boundary>
1429              
1430             The boundary used.
1431              
1432             =item * C<charset>
1433              
1434             The optional charset of the attachment.
1435              
1436             =item * C<cid> or C<id>
1437              
1438             The attachment ID (C<Content-ID>)
1439              
1440             =item * C<data>
1441              
1442             The attachement raw data.
1443              
1444             =item * C<debug>
1445              
1446             An unsigned integer to enable debugging.
1447              
1448             =item * C<description>
1449              
1450             A short description.
1451              
1452             See also C<path> for an alternative.
1453              
1454             =item * C<disposition>
1455              
1456             Can be either C<attachment> or C<inline>
1457              
1458             =item * C<encoding>
1459              
1460             The encoding of the attachment, such as C<zip>, C<gzip>, C<bzip2>, etc..
1461              
1462             =item * C<filename>
1463              
1464             The attachment filename as displayed to the reader.
1465              
1466             =item * C<path>
1467              
1468             The attachment file path.
1469              
1470             See also C<data> for an alternative.
1471              
1472             =item * C<type>
1473              
1474             The attachment mime-type.
1475              
1476             =back
1477              
1478             =head2 bcc( @addresses )
1479              
1480             $mail->bcc( qw( hello@example.com john@example.jp ) );
1481              
1482             $mail->bcc( [qw( hello@example.com john@example.jp )] );
1483              
1484             Accumulates one or more BCC addresses. May be called multiple times.
1485              
1486             This takes either an array reference or a list of e-mail addresses, encode them if necessary, and add them to the C<Bcc> mail envelop header as a comma-separated value using L<Mail::Make::Headers/push_header>
1487              
1488             When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1489              
1490             =head2 cc( @addresses )
1491              
1492             $mail->cc( qw( hello@example.com john@example.jp ) );
1493              
1494             $mail->cc( [qw( hello@example.com john@example.jp )] );
1495              
1496             Accumulates one or more CC addresses.
1497              
1498             This takes either an array reference or a list of e-mail addresses, encode them if necessary, and add them to the C<Cc> mail envelop header as a comma-separated value using L<Mail::Make::Headers/push_header>
1499              
1500             When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1501              
1502             =head2 date( [$date_string_or_epoch] )
1503              
1504             Gets or sets the C<Date> header.
1505              
1506             Accepts a Unix epoch integer (converted to RFC 5322 format automatically) or a pre-formatted RFC 5322 string.
1507              
1508             Delegates to L<Mail::Make::Headers/date>. If not set explicitly, the current date and time are used when L</as_entity> is first called.
1509              
1510             When called as a mutator, it returns the current instance of L<Mail::Make::Headers>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1511              
1512             =head2 from( [$address] )
1513              
1514             $mail->from( 'hello@example.com' );
1515              
1516             Gets or sets the C<From> header by calling L<Mail::Make::Headers/set>.
1517              
1518             Non-ASCII display names are RFC 2047 encoded automatically.
1519              
1520             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1521              
1522             =head2 header( $name [, $value] )
1523              
1524             $mail->header( 'X-Mailer' => 'MySoft/v1.0.0' ); # returns $mail
1525             # or
1526             $mail->header( X_Mailer => 'MySoft/v1.0.0' ); # returns $mail
1527              
1528             my $software = $mail->header( 'X-Mailer' );
1529              
1530             With two arguments: appends an arbitrary header to the envelope using L<push_header|Mail::Make::Headers/push_header> semantics (does not replace an existing field of the same name).
1531              
1532             Returns the current instance of C<Mail::Make>
1533              
1534             With one argument: returns the current value of the named header.
1535              
1536             =head2 headers()
1537              
1538             my $headers = $mail->headers; # Mail::Make::Headers
1539              
1540             Returns the internal L<Mail::Make::Headers> object. Use this for operations not covered by the fluent methods, such as setting C<X-*> headers or reading back any field.
1541              
1542             =head2 html( $content [, %opts] )
1543              
1544             $mail->html( '<p>Hello world</p>', {
1545             charset => 'utf-8',
1546             encoding => 'quoted-printable',
1547             }); # returns $mail
1548              
1549             Adds a C<text/html> body part, and returns the current instance for chaining.
1550              
1551             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1552              
1553             This takes an optional hash or hash reference of the following parameters:
1554              
1555             =over 4
1556              
1557             =item * C<charset>
1558              
1559             The character set used for thise HTML data.
1560              
1561             Defaults to C<utf-8>
1562              
1563             =item * C<data>
1564              
1565             The HTML data.
1566              
1567             =item * C<encoding>
1568              
1569             Can be C<quoted-printable> or C<base64>
1570              
1571             Defaults to C<quoted-printable>
1572              
1573             =back
1574              
1575             =head2 in_reply_to( [$mid] )
1576              
1577             $mail->in_reply_to( 'dave.null@example.com' ); # Returns $mail
1578             my $email = $mail->in_reply_to;
1579              
1580             Gets or sets the C<In-Reply-To> header.
1581              
1582             In mutator mode, this sets the C<In-Reply-To> mail envelop header using L<Mail::Make::Headers/set>, and returns the current instance of C<Mail::Make>, and in accessor mode, this returns the current value for the mail envelop header C<In-Reply-To>
1583              
1584             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1585              
1586             =head2 message_id( [$mid | \%opts] )
1587              
1588             $mail->message_id( '2adefb89-a26a-4cf1-91c7-1413b13cfd0f@local' ); # Returns $mail
1589             $mail->message_id( '2adefb89-a26a-4cf1-91c7-1413b13cfd0f@local', { strict => 1 } ); # Returns $mail
1590             $mail->message_id({ generate => 1, domain => 'example.com' });
1591             $mail->message_id( undef ); # remove the message ID
1592             my $msgid = $mail->message_id;
1593              
1594             Gets or sets the C<Message-ID>. Auto-generated when L</as_entity> is called if not explicitly set.
1595              
1596             Delegates to L<Mail::Make::Headers/message_id>.
1597              
1598             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1599              
1600             This takes an optional hash reference of the following parameters:
1601              
1602             =over 4
1603              
1604             =item * C<domain>
1605              
1606             The domain name to use when generating the message ID.
1607              
1608             =item * C<generate>
1609              
1610             If set to true, then L<Mail::Make::Headers/message_id> will generate the message ID.
1611              
1612             If the option C<domain> is not provided, it will use L<Sys::Hostname/hostname> to guess the domain name.
1613              
1614             =item * C<strict>
1615              
1616             A boolean value (C<1> or C<0>).
1617              
1618             When this is set to true, L<message_id>|Mail::Make::Headers/message_id> will call C<_validate_message_id_value> in L<Mail::Make::Headers> to thoroughly validate the value provided. This means, it will reject the value if:
1619              
1620             =over 8
1621              
1622             =item 1. It contains any non-ASCII or spaces/control characters.
1623              
1624             =item 2. It is not wrapped in angle brackets: C<< < >> and C<< > >>
1625              
1626             =item 3. Does not have exactly one at-mark C<@>
1627              
1628             =item 4. The local part (the part on the left of the at-mark) contains characters other than:
1629              
1630             [A-Za-z0-9.!#\$%&'\*\+\/=\?\^_`\{\|\}~\-]+
1631              
1632             =item 5. The domain part (the part of the right of the at-mark) contains characters other than:
1633              
1634             [A-Za-z0-9](?:[A-Za-z0-9\-\.]*[A-Za-z0-9])?
1635              
1636             =back
1637              
1638             =back
1639              
1640             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1641              
1642             =head2 plain( $content [, %opts] )
1643              
1644             $mail->plain( 'Hello world', {
1645             charset => 'utf-8',
1646             encoding => 'quoted-printable',
1647             }); # returns $mail
1648              
1649             Adds a C<text/plain> body part, and returns the current instance for chaining.
1650              
1651             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1652              
1653             This takes an optional hash or hash reference of the following parameters:
1654              
1655             =over 4
1656              
1657             =item * C<charset>
1658              
1659             The character set used for thise HTML data.
1660              
1661             Defaults to C<utf-8>
1662              
1663             =item * C<data>
1664              
1665             The HTML data.
1666              
1667             =item * C<encoding>
1668              
1669             Can be C<quoted-printable> or C<base64>
1670              
1671             Defaults to C<quoted-printable>
1672              
1673             =back
1674              
1675             =head2 references( @mids )
1676              
1677             $mail->references( [ $msg_id1, $msg_id2 ] ); # Returns $mail
1678             $mail->references( $msg_id1, $msg_id2 ); # Returns $mail
1679             # Removes the header
1680             $mail->references( undef ); # Returns $mail
1681             my @message_ids = $mail->references;
1682             my $comma_list = $mail->references;
1683              
1684             Accumulates one or more Message-IDs in the C<References> header.
1685              
1686             In mutator mode, this returns the current instance of L<Mail::Make>
1687              
1688             In accessor mode, this returns a list of message IDs, and in scalar mode, this returns a comma-separate list of message IDs.s
1689              
1690             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1691              
1692             =head2 reply_to( [$address] )
1693              
1694             $mail->reply_to( 'hello@example.com' );
1695              
1696             Gets or sets the C<Reply-To> header by calling L<Mail::Make::Headers/set>.
1697              
1698             Non-ASCII display names are RFC 2047 encoded automatically.
1699              
1700             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1701              
1702             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1703              
1704             =head2 return_path( [$address] )
1705              
1706             $mail->return_path( 'dave.null@example.com' );
1707              
1708             Gets or sets the C<Return-Path> header by calling L<Mail::Make::Headers/set>.
1709              
1710             Non-ASCII display names are RFC 2047 encoded automatically.
1711              
1712             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1713              
1714             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1715              
1716             =head2 sender( [$address] )
1717              
1718             $mail->sender( 'hello@example.com' );
1719              
1720             Gets or sets the C<Sender> header by calling L<Mail::Make::Headers/set>.
1721              
1722             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1723              
1724             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1725              
1726             =head2 subject( [$string] )
1727              
1728             $mail->subject( '会議議事録' ); # Returns $mail
1729             $mail->subject;
1730              
1731             Gets or sets the C<Subject> by calling L<Mail::Make::Headers/set>.
1732              
1733             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1734              
1735             Non-ASCII subjects are RFC 2047 encoded before being stored.
1736              
1737             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1738              
1739             =head2 to( @addresses )
1740              
1741             $mail->to( 'hello@example.com' );
1742              
1743             Accumulates one or more To addresses. Multiple calls are merged into a single C<To:> field per RFC 5322 §3.6.3 by calling L<Mail::Make::Headers/set>.
1744              
1745             Non-ASCII display names are RFC 2047 encoded automatically.
1746              
1747             Note that it is up to you to ensure there are no duplicates.
1748              
1749             When called as a mutator, it returns the current instance of L<Mail::Make>, otherwise, as an accessor, it returns the current value of the mail envelop header.
1750              
1751             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1752              
1753             =head1 OUTPUT METHODS
1754              
1755             =head2 as_entity
1756              
1757             my $entity = $mail->as_entity; # Returns a Mail::Make::Entity object
1758              
1759             Assembles and returns the top-level L<Mail::Make::Entity> based on the various content that has been specified, such as plain text, html mail, attachments, or inline attachments.
1760              
1761             The MIME structure is selected automatically (see L</DESCRIPTION>). Envelope headers are merged into the entity using C<init_header> semantics: fields already set on the entity (C<Content-Type>, C<MIME-Version>, etc.) are never overwritten.
1762              
1763             If no C<Message-ID> is set yet, it will compute one.
1764              
1765             C<MIME-Version> will be set to C<1.0> no matter what value may have been set previously.
1766              
1767             The computed value is cached, so repetitive calls will return the cached value.
1768              
1769             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1770              
1771             =head2 as_string
1772              
1773             my $string = $mail->as_string;
1774              
1775             Assembles the message and returns it as a plain string, consistent with C<MIME::Entity::stringify>. This is the form suitable for direct printing, string interpolation, and most downstream consumers.
1776              
1777             For large messages, prefer L</print> (no buffering) or L</as_string_ref> (no copy on return).
1778              
1779             This method calls L</as_entity>, and returns the value returned by L<Mail::Make::Entity/as_string>, passing it whatever value was provided.
1780              
1781             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1782              
1783             =head2 as_string_ref
1784              
1785             my $scalar_ref = $mail->as_string_ref;
1786              
1787             Assembles the message and returns it as a B<scalar reference> (or a L<Module::Generic::Scalar> object, which stringifies as needed). No extra string copy is made during the fast path.
1788              
1789             When L</use_temp_file> is true, B<or> the serialised entity size returned by L<Mail::Make::Entity/length> exceeds L</max_body_in_memory_size>, the message is written to a C<Module::Generic::Scalar> buffer via its in-memory filehandle.
1790             This keeps peak RAM use to a single copy of the assembled message.
1791              
1792             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1793              
1794             =head2 max_body_in_memory_size( [$bytes] )
1795              
1796             Gets or sets the byte threshold above which L</as_string_ref> spools to a temporary file rather than building the message in RAM. Set to C<0> or C<undef> to disable the threshold entirely. Default: C<$Mail::Make::MAX_BODY_IN_MEMORY_SIZE> (1 MiB).
1797              
1798             =head2 print( $fh )
1799              
1800             $mail->print( $fh ) || die( $mail->error );
1801              
1802             Writes the fully assembled message to a filehandle without buffering it in memory. This is the recommended approach for very large messages: the MIME tree is serialised part by part directly to C<$fh>, keeping memory use proportional to the largest single part rather than the total message size.
1803              
1804             This returns the current instance of L<Mail::Make> for chaining.
1805              
1806             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1807              
1808             =head2 smtpsend( %opts )
1809              
1810             my @recipients = $mail->smtpsend( Host => $smtp );
1811              
1812             my $rv = $mail->smtpsend(
1813             Host => '127.0.0.1',
1814             Port => $port,
1815             Hello => 'test.local',
1816             );
1817              
1818             my $recipients_array_ref = $mail->smtpsend(
1819             Host => '127.0.0.1',
1820             Port => $port,
1821             Hello => 'test.local',
1822             MailFrom => 'bounce@example.com',
1823             );
1824              
1825             Assembles the message and submits it to an SMTP server via L<Net::SMTP>, which is a core perl module, and loaded only when this method is called.
1826              
1827             This takes a hash or hash reference of options.
1828              
1829             Credential and recipient validation is performed B<before> any network connection is attempted, so configuration errors are reported immediately without consuming network resources.
1830              
1831             Recognised options:
1832              
1833             =over 4
1834              
1835             =item C<AuthMechanisms>
1836              
1837             Space-separated list of SASL mechanism names in preference order.
1838              
1839             Defaults to C<"PLAIN LOGIN">, which are safe and universally supported over an encrypted channel (STARTTLS or SSL).
1840              
1841             The actual mechanism used is the intersection of this list and what the server advertises. If no intersection exists, deprecated challenge-response mechanisms (C<DIGEST-MD5>, C<CRAM-MD5>, C<GSSAPI>) are excluded and the remainder of the server's list is tried.
1842              
1843             =item C<Debug>
1844              
1845             Boolean. Enables L<Net::SMTP> debug output.
1846              
1847             =item C<Hello>
1848              
1849             The FQDN sent in the EHLO/HELO greeting.
1850              
1851             =item C<Host>
1852              
1853             Hostname, IP address, or an already-connected L<Net::SMTP> object. If an existing object is passed, it is used as-is and B<not> quit on completion (the caller retains ownership of the connection).
1854              
1855             If omitted, the colon-separated list in C<$ENV{SMTPHOSTS}> is tried first, then C<mailhost> and C<localhost> in that order.
1856              
1857             =item C<MailFrom>
1858              
1859             The envelope sender address (C<MAIL FROM>). Defaults to the bare addr-spec extracted from the C<From:> header.
1860              
1861             =item C<Password>
1862              
1863             Password for SMTP authentication. May be:
1864              
1865             =over 4
1866              
1867             =item * A plain string.
1868              
1869             =item * A C<CODE> reference called with no arguments at authentication time.
1870              
1871             Useful for reading credentials from a keyring or secrets manager without storing them in memory until needed:
1872              
1873             Password => sub { MyKeyring::get('smtp') }
1874              
1875             =back
1876              
1877             =item C<Port>
1878              
1879             SMTP port number. Common values:
1880              
1881             =over 4
1882              
1883             =item * C<25> - plain SMTP (default when C<SSL> is false)
1884              
1885             =item * C<465> - SMTPS, direct SSL/TLS (use with C<< SSL => 1 >>)
1886              
1887             =item * C<587> - submission, usually STARTTLS (use with C<< StartTLS => 1 >>)
1888              
1889             =back
1890              
1891             =item C<SSL>
1892              
1893             Boolean. When true, the connection is wrapped in SSL/TLS from the start (SMTPS, typically port 465).
1894              
1895             Requires L<IO::Socket::SSL>.
1896              
1897             =item C<StartTLS>
1898              
1899             Boolean. When true, a plain connection is established first and then upgraded to TLS via the SMTP C<STARTTLS> extension (typically port 587).
1900              
1901             Requires L<IO::Socket::SSL>. Ignored when C<Host> is a pre-built L<Net::SMTP> object.
1902              
1903             =item C<SSL_opts>
1904              
1905             Hash reference of additional options passed to L<IO::Socket::SSL> during the SSL/TLS handshake. For example:
1906              
1907             SSL_opts => { SSL_verify_mode => 0 } # disable peer cert check
1908             SSL_opts => { SSL_ca_file => '/etc/ssl/ca.pem' }
1909              
1910             =item C<Timeout>
1911              
1912             Connection and command timeout in seconds, passed directly to L<Net::SMTP>.
1913              
1914             =item C<To>, C<Cc>, C<Bcc>
1915              
1916             Override the RCPT TO list. Each may be a string or an array reference of addresses. When omitted, the corresponding message headers are used.
1917              
1918             C<Bcc:> is always stripped from the outgoing message headers before transmission, per RFC 2822 §3.6.3.
1919              
1920             =item C<Username>
1921              
1922             Login name for SMTP authentication (SASL). Requires L<Authen::SASL>.
1923              
1924             Must be combined with C<Password>. Validated before any connection is made.
1925              
1926             =back
1927              
1928             B<Typical usage examples:>
1929              
1930             # Plain SMTP, no auth (LAN relay)
1931             $mail->smtpsend( Host => 'mail.example.com' );
1932              
1933             # SMTPS (direct TLS, port 465)
1934             $mail->smtpsend(
1935             Host => 'smtp.example.com',
1936             Port => 465,
1937             SSL => 1,
1938             Username => 'jack@example.com',
1939             Password => 'secret',
1940             );
1941              
1942             # Submission with STARTTLS (port 587) and password callback
1943             $mail->smtpsend(
1944             Host => 'smtp.example.com',
1945             Port => 587,
1946             StartTLS => 1,
1947             Username => 'jack@example.com',
1948             Password => sub { MyKeyring::get('smtp_pass') },
1949             );
1950              
1951             Returns the list of accepted recipient addresses in list context, or a reference to that list in scalar context.
1952              
1953             If an error occurs, it sets an L<exception object|Mail::Make::Exception>, and returns C<undef> in scalar context, or an empty list in list context.
1954              
1955             =head2 use_temp_file( [$bool] )
1956              
1957             When true, L</as_string_ref> always spools to a temporary file regardless of message size. Useful when you know the message will be large, or when you want to bound peak memory use unconditionally. Default: false.
1958              
1959             =head1 GPG METHODS
1960              
1961             These methods delegate to L<Mail::Make::GPG>, which requires L<IPC::Run> and a working C<gpg> (or C<gpg2>) installation. All three methods produce RFC 3156-compliant messages and return a new L<Mail::Make> object suitable for passing directly to C<smtpsend()>.
1962              
1963             =head2 gpg_encrypt( %opts )
1964              
1965             Encrypts this message for one or more recipients and returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/encrypted; protocol="application/pgp-encrypted"> message.
1966              
1967             Required options:
1968              
1969             =over 4
1970              
1971             =item Recipients => \@addrs_or_key_ids
1972              
1973             Array reference of recipient e-mail addresses or key fingerprints. Each recipient's public key must already be present in the local GnuPG keyring, unless C<AutoFetch> is enabled.
1974              
1975             =back
1976              
1977             Optional options:
1978              
1979             =over 4
1980              
1981             =item C<< AutoFetch => $bool >>
1982              
1983             When true and C<KeyServer> is set, calls C<gpg --locate-keys> for each recipient before encryption. Default: C<0>.
1984              
1985             =item C<< Digest => $algorithm >>
1986              
1987             Hash algorithm for the signature embedded in the encrypted payload.
1988             Default: C<SHA256>.
1989              
1990             =item C<< GpgBin => $path >>
1991              
1992             Full path to the C<gpg> executable. Defaults to searching C<gpg2> then C<gpg> in C<PATH>.
1993              
1994             =item C<< KeyServer => $url >>
1995              
1996             Keyserver URL for auto-fetching recipient public keys (e.g. C<'keys.openpgp.org'>). Only consulted when C<AutoFetch> is true.
1997              
1998             =back
1999              
2000             =head2 gpg_sign( %opts )
2001              
2002             Signs this message and returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/signed; protocol="application/pgp-signature"> message with a detached, ASCII-armoured signature.
2003              
2004             Required options:
2005              
2006             =over 4
2007              
2008             =item C<< KeyId => $fingerprint_or_id >>
2009              
2010             Signing key fingerprint or short ID (e.g. C<'35ADBC3AF8355E845139D8965F3C0261CDB2E752'>).
2011              
2012             =back
2013              
2014             Optional options:
2015              
2016             =over 4
2017              
2018             =item C<< Digest => $algorithm >>
2019              
2020             Hash algorithm. Default: C<SHA256>.
2021              
2022             Valid values: C<SHA256>, C<SHA384>, C<SHA512>, C<SHA1>.
2023              
2024             =item C<< GpgBin => $path >>
2025              
2026             Full path to the C<gpg> executable.
2027              
2028             =item C<< Passphrase => $string_or_coderef >>
2029              
2030             Passphrase to unlock the secret key. May be a plain string or a C<CODE> reference called with no arguments at signing time. When omitted, GnuPG's agent handles passphrase prompting.
2031              
2032             =back
2033              
2034             =head2 gpg_sign_encrypt( %opts )
2035              
2036             Signs then encrypts this message. Returns a new L<Mail::Make> object whose entity is an RFC 3156 C<multipart/encrypted> message containing a signed and encrypted OpenPGP payload.
2037              
2038             Accepts all options from both L</gpg_sign> and L</gpg_encrypt>.
2039              
2040             B<Note:> C<KeyId> and C<Recipients> are both required.
2041              
2042             B<Typical usage:>
2043              
2044             # Sign only
2045             my $signed = $mail->gpg_sign(
2046             KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
2047             Passphrase => 'my-passphrase', # or: sub { MyKeyring::get('gpg') }
2048             ) || die $mail->error;
2049             $signed->smtpsend( Host => 'smtp.example.com' );
2050              
2051             # Encrypt only
2052             my $encrypted = $mail->gpg_encrypt(
2053             Recipients => [ 'alice@example.com' ],
2054             ) || die $mail->error;
2055              
2056             # Sign then encrypt
2057             my $protected = $mail->gpg_sign_encrypt(
2058             KeyId => '35ADBC3AF8355E845139D8965F3C0261CDB2E752',
2059             Passphrase => sub { MyKeyring::get_passphrase() },
2060             Recipients => [ 'alice@example.com', 'bob@example.com' ],
2061             ) || die $mail->error;
2062              
2063             =head1 S/MIME METHODS
2064              
2065             These methods delegate to L<Mail::Make::SMIME>, which requires L<Crypt::SMIME> (an XS module wrapping OpenSSL C<libcrypto>). All certificates and keys must be supplied in PEM format, either as file paths or as PEM strings.
2066              
2067             =head2 Memory usage
2068              
2069             All three methods load the complete serialised message into memory before performing any cryptographic operation. This is a fundamental constraint imposed by two factors: the L<Crypt::SMIME> API accepts only Perl strings (no filehandle or streaming interface), and the underlying protocols themselves require the entire content to be available before the result can be emitted, thus signing requires a complete hash before the signature can be appended, and PKCS#7 encryption requires the total payload length to be declared in the ASN.1 DER header before any ciphertext is written.
2070              
2071             For typical email messages this is not a concern. If you anticipate very large attachments, consider L<Mail::Make::GPG> instead, which delegates to the C<gpg> command-line tool via L<IPC::Run> and can handle arbitrary message sizes through temporary files. A future C<v0.2.0> of L<Mail::Make::SMIME> may add a similar C<openssl smime> backend.
2072              
2073             See L<Mail::Make::SMIME/"MEMORY USAGE AND LIMITATIONS"> for a full discussion.
2074              
2075             =head2 smime_encrypt( %opts )
2076              
2077             $encrypted = $mail->smime_encrypt(
2078             RecipientCert => $smime_rec_cert,
2079             );
2080              
2081             Encrypts this message for one or more recipients and returns a new C<Mail::Make> object whose entity is an RFC 5751 C<application/pkcs7-mime; smime-type=enveloped-data> message.
2082              
2083             Takes an hash or hash reference of options.
2084              
2085             Required options:
2086              
2087             =over 4
2088              
2089             =item C<< RecipientCert => $pem_string_or_path >>
2090              
2091             Recipient certificate in PEM format (for encryption). May also be an array reference of PEM strings or file paths for multi-recipient encryption.
2092              
2093             =back
2094              
2095             Optional options:
2096              
2097             =over 4
2098              
2099             =item C<< CACert => $pem_string_or_path >>
2100              
2101             CA certificate to include for chain verification.
2102              
2103             =back
2104              
2105             =head2 smime_sign( %opts )
2106              
2107             my $signed = $mail->smime_sign(
2108             Cert => $smime_cert,
2109             Key => $smime_key,
2110             CACert => $smime_ca, # optional
2111             );
2112              
2113             Signs this message with a detached S/MIME signature and returns a new C<Mail::Make> object whose entity is an RFC 5751 C<multipart/signed> message.
2114              
2115             The signature is always detached, which allows non-S/MIME-aware clients to read the message body.
2116              
2117             Required options:
2118              
2119             =over 4
2120              
2121             =item C<< Cert => $pem_string_or_path >>
2122              
2123             Signer certificate in PEM format.
2124              
2125             =item C<< Key => $pem_string_or_path >>
2126              
2127             Private key in PEM format.
2128              
2129             =back
2130              
2131             Optional options:
2132              
2133             =over 4
2134              
2135             =item C<< KeyPassword => $string_or_coderef >>
2136              
2137             Passphrase for an encrypted private key, or a CODE ref that returns one.
2138              
2139             =item C<< CACert => $pem_string_or_path >>
2140              
2141             CA certificate to include in the signature for chain verification.
2142              
2143             =back
2144              
2145             =head2 smime_sign_encrypt( %opts )
2146              
2147             my $result = $mail->smime_sign_encrypt(
2148             Cert => $smime_cert,
2149             Key => $smime_key,
2150             RecipientCert => $smime_rec_cert,
2151             CACert => $smime_ca, # optional
2152             );
2153              
2154             Signs this message then encrypts the signed result. Returns a new C<Mail::Make> object whose entity is an RFC 5751 enveloped message containing a signed payload.
2155              
2156             Accepts all options from both L</smime_sign> and L</smime_encrypt>.
2157              
2158             B<Note:> C<Cert>, C<Key>, and C<RecipientCert> are all required.
2159              
2160             B<Typical usage:>
2161              
2162             # Sign only
2163             my $signed = $mail->smime_sign(
2164             Cert => '/path/to/my.cert.pem',
2165             Key => '/path/to/my.key.pem',
2166             CACert => '/path/to/ca.crt',
2167             ) || die $mail->error;
2168             $signed->smtpsend( Host => 'smtp.example.com' );
2169              
2170             # Encrypt only
2171             my $encrypted = $mail->smime_encrypt(
2172             RecipientCert => '/path/to/recipient.cert.pem',
2173             ) || die $mail->error;
2174              
2175             # Sign then encrypt
2176             my $protected = $mail->smime_sign_encrypt(
2177             Cert => '/path/to/my.cert.pem',
2178             Key => '/path/to/my.key.pem',
2179             RecipientCert => '/path/to/recipient.cert.pem',
2180             ) || die $mail->error;
2181              
2182             =head1 PRIVATE METHODS
2183              
2184             =head2 _default_domain
2185              
2186             Returns a FQDN for auto-generated C<Message-ID> values. Uses L<Sys::Hostname> and appends C<.local> when the hostname contains no dot.
2187              
2188             Falls back to C<mail.make.local>.
2189              
2190             =head2 _encode_address( $addr_string )
2191              
2192             Encodes the display-name portion of an RFC 2822 address using RFC 2047 when the display name contains non-ASCII characters. The addr-spec is never modified.
2193              
2194             =head2 _encode_header( $string )
2195              
2196             Encodes an arbitrary header string for the wire using RFC 2047 encoded-words.
2197              
2198             Delegates to L<Mail::Make::Headers::Subject>.
2199              
2200             =head2 _format_date
2201              
2202             Returns the current local date and time as an RFC 2822 string.
2203              
2204             =head1 AUTHOR
2205              
2206             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
2207              
2208             =head1 SEE ALSO
2209              
2210             RFC 2045, RFC 2046, RFC 2047, RFC 2183, RFC 2231, RFC 2822
2211              
2212             L<Mail::Make::Entity>, L<Mail::Make::Headers>, L<Mail::Make::Headers::ContentType>, L<Mail::Make::Headers::ContentDisposition>, L<Mail::Make::Headers::ContentTransferEncoding>, L<Mail::Make::Body::InCore>, L<Mail::Make::Body::File>, L<Mail::Make::Stream::Base64>, L<Mail::Make::Stream::QuotedPrint>, L<Mail::Make::Exception>, L<Net::SMTP>
2213              
2214             =head1 COPYRIGHT & LICENSE
2215              
2216             Copyright(c) 2026 DEGUEST Pte. Ltd.
2217              
2218             All rights reserved.
2219              
2220             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
2221              
2222             =cut