File: Text.pm

package info (click to toggle)
libmail-box-perl 2.068-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 3,576 kB
  • ctags: 1,493
  • sloc: perl: 22,358; makefile: 49
file content (76 lines) | stat: -rw-r--r-- 1,579 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

use strict;

package Mail::Message;
use vars '$VERSION';
$VERSION = '2.068';

use IO::Lines;


sub string()
{   my $self = shift;
    $self->head->string . $self->body->string;
}

#------------------------------------------


sub lines()
{   my $self = shift;
    my @lines;
    my $file = IO::Lines->new(\@lines);
    $self->print($file);
    wantarray ? @lines : \@lines;
}

#------------------------------------------


sub file()
{   my $self = shift;
    my @lines;
    my $file = IO::Lines->new(\@lines);
    $self->print($file);
    $file->seek(0,0);
    $file;
}

#------------------------------------------


sub printStructure(;$$)
{   my $self    = shift;

    my $indent
      = @_==2                       ? pop
      : defined $_[0] && !ref $_[0] ? shift
      :                               '';

    my $fh      = @_ ? shift : select;

    my $buffer;   # only filled if filehandle==undef
    open $fh, '>', \$buffer unless defined $fh;

    my $subject = $self->get('Subject') || '';
    $subject    = ": $subject" if length $subject;

    my $type    = $self->get('Content-Type') || '';
    my $size    = $self->size;
    my $deleted = $self->label('deleted') ? ', deleted' : '';

    my $text    = "$indent$type$subject ($size bytes$deleted)\n";
    ref $fh eq 'GLOB' ? (print $fh $text) : $fh->print($text);

    my $body    = $self->body;
    my @parts
      = $body->isMultipart ? $body->parts
      : $body->isNested    ? ($body->nested)
      :                      ();

    $_->printStructure($fh, $indent.'   ') foreach @parts;
    $buffer;
}
    

1;