Current File : //usr/share/perl5/vendor_perl/Amavis/Unpackers/Part.pm

# SPDX-License-Identifier: GPL-2.0-or-later

package Amavis::Unpackers::Part;
use strict;
use re 'taint';

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
}

use Amavis::Util qw(ll do_log);

use vars qw($file_generator_object);
sub init($) { $file_generator_object = $_[0] }

sub new($;$$$) {  # create a part descriptor object
  my($class, $dir_name,$parent,$ignore_limit) = @_;
  my $self = bless {}, $class;
  if (!defined($dir_name) && !defined($parent)) {
    # just make an empty object, presumably used as a new root
  } else {
    $self->number($file_generator_object->generate_new_num($ignore_limit));
    $self->dir_name($dir_name)  if defined $dir_name;
    if (defined $parent) {
      $self->parent($parent);
      my $ch_ref = $parent->children;
      push(@$ch_ref,$self); $parent->children($ch_ref);
    }
    $file_generator_object->parts_list_add($self);  # save it
    ll(4) && do_log(4, "Issued a new %s: %s",
            defined $dir_name ? "file name" : "pseudo part", $self->base_name);
  }
  $self;
}

sub number
  { @_<2 ? shift->{number}   : ($_[0]->{number} = $_[1]) };
sub dir_name
  { @_<2 ? shift->{dir_name} : ($_[0]->{dir_name} = $_[1]) };
sub parent
  { @_<2 ? shift->{parent}   : ($_[0]->{parent} = $_[1]) };
sub children
  { @_<2 ? shift->{children}||[] : ($_[0]->{children} = $_[1]) };
sub mime_placement    # part location within a MIME tree, e.g. "1/1/3"
  { @_<2 ? shift->{place}    : ($_[0]->{place} = $_[1]) };
sub type_short        # string or a ref to a list of strings, case sensitive
  { @_<2 ? shift->{ty_short} : ($_[0]->{ty_short} = $_[1]) };
sub type_long
  { @_<2 ? shift->{ty_long}  : ($_[0]->{ty_long} = $_[1]) };
sub type_declared
  { @_<2 ? shift->{ty_decl}  : ($_[0]->{ty_decl} = $_[1]) };
sub name_declared     # string or a ref to a list of strings
  { @_<2 ? shift->{nm_decl}  : ($_[0]->{nm_decl} = $_[1]) };
sub report_type       # a string, e.g. 'delivery-status', RFC 6522
  { @_<2 ? shift->{rep_typ}  : ($_[0]->{rep_typ} = $_[1]) };
sub size              # size in bytes
  { @_<2 ? shift->{size}     : ($_[0]->{size} = $_[1]) };
sub digest            # digest of a mime part contents (typically SHA1, hex)
  { @_<2 ? shift->{digest}   : ($_[0]->{digest} = $_[1]) };
sub exists
  { @_<2 ? shift->{exists}   : ($_[0]->{exists} = $_[1]) };
sub attributes        # a string of characters representing attributes
  { @_<2 ? shift->{attr}     : ($_[0]->{attr} = $_[1]) };

sub attributes_add {  # U=undecodable, C=crypted, B=ambiguous-content,
                      # D=directory, S=special, L=link
  my $self = shift; my $a = $self->{attr}; $a = '' if !defined $a;
  for my $arg (@_) { $a .= $arg  if $arg ne '' && index($a,$arg) < 0 }
  $self->{attr} = $a;
};

sub base_name { my $self = $_[0]; sprintf("p%03d",$self->number) }

sub full_name {
  my $self = $_[0]; my $d = $self->dir_name;
  !defined($d) ? undef : $d.'/'.$self->base_name;
}

# returns a ref to a list of part ancestors, starting with the root object,
# and including the part object itself
#
sub path {
  my $self = $_[0];
  my(@path);
  for (my $p=$self; defined($p); $p=$p->parent) { unshift(@path,$p) }
  \@path;
};

1;