view release on metacpan or  search on metacpan

lib/Data/Header/Fields.pm  view on Meta::CPAN

	}
	else { 
		croak 'more then one header field with name "'.$key.'"';
	}
	
	
	return $self;
}

sub cmp {
	my $a = shift;
	my $b = shift;
	
	$a = $a->encode if ref $a and $a->can('encode');
	$b = $b->encode if ref $b and $b->can('encode');
	
	return $a cmp $b;
}

sub keys {
	my $self  = shift;	
	my $lines = shift || (ref $self ? $self->_lines : []);
	
	return
		uniq
		map {
			$_->key
		} @{$lines}
	;
}

sub line_ending {
	my $self = shift;
	
	return "\n"
		if not ref $self;
	
	if (@_) {
		$self->{line_ending} = shift;
	}
	$self->{line_ending} = "\n"
		if (not $self->{line_ending});
	
	return $self->{line_ending};
}

sub push_line {
	my $self = shift;
	my $line = shift;

	my $lines = $self->_lines;
	push(@$lines, $line);

	return $self;
}

1;

package Data::Header::Fields::Value;

use Scalar::Util 'weaken', 'isweak';

use overload
	'""' => \&as_string,
	'cmp' => \&cmp,
;

sub new {
	my $class = shift;
	my $value = shift;
	
	if (@_ == 0) {
		if (not ref $value) {
			$value = { 'value' => $value };
		}
	}
	else {
		$value = { $value, @_ };
	}
	
	my $self = bless { 'parent' => $class->_default_parent, %{$value} }, $class;
	
	weaken($self->{'parent'})
		if (ref($self->{'parent'}) && !isweak($self->{'parent'}));
	
	return $self;
}

sub as_string {
	my $self   = shift;

	# remove folding
	my $line = $self->{value};
	if ($self->parent->parent->tight_folding) {
		$line =~ s/\n\s//xmsg;
	}
	else {
		$line =~ s/\n(\s)/$1/xmsg;
	}
	$line =~ s/\r?\n$//;
	$line = String::Escape::unprintable($line);
	
	return $line;
}

sub cmp {
	my $a = shift;
	my $b = shift;
	
	$a = $a->as_string if ref $a and $a->can('as_string');
	$b = $b->as_string if ref $b and $b->can('as_string');
	
	return $a cmp $b;
}

sub _default_parent {
	return 'Data::Header::Fields::Line';
}

sub parent {
	my $self   = shift;
	$self->{'parent'} = shift
		if @_;
	
	return (ref $self->{'parent'} ? $self->{'parent'} : $self->_default_parent);
}

sub value {
	my $self = shift;
	
	if (@_) {
		$self->{'value'} = shift;
		$self->parent->line_changed;
	}
	
	return $self->{'value'};
}
1;

package Data::Header::Fields::Line;

use Scalar::Util 'blessed', 'weaken', 'isweak';

use overload
	'""' => \&as_string,
	'cmp' => \&cmp,
;

sub new {
	my $class = shift;
	my $line  = shift;
	my @args  = @_;
	
	if (@args > 0) {
		$line = { $line, @args };
	}
	
	if (not ref $line) {
		$line = { 'line' => $line };
	}
	
	$line = { 'parent' => $class->_default_parent, %{$line} };
	
	if (exists $line->{'line'}) {
		# reblessing the line object
		if (blessed $line->{'line'}) {
			my $self = delete $line->{'line'};
			foreach my $key (keys %{$line}) {
				$self->{$key} = $line->{$key};
			}
			return bless $self, $class;			
		}
		else {
			my $line_string   = delete $line->{'line'};
			$line->{'original_line'} = $line_string;
			my ($key, $value) = split(/:/, $line_string, 2);
			$line->{'key'}    = $key;
			$line->{'value'}  = Data::Header::Fields::Value->new(
				'value'         => $value,
				'parent'        => $line,
			);
		}
	}
	
	weaken($line->{'parent'})
		if (ref($line->{'parent'}) && !isweak($line->{'parent'}));
	
	return bless $line, $class;
}

sub key {
	my $self   = shift;
	$self->{'key'} = shift
		if @_;
	
	return $self->{'key'};
}
sub value {
	my $self   = shift;
	$self->line_changed->{'value'} = shift
		if @_;
	
	return $self->{'value'};
}

sub line_changed {
	my $self = shift;
	delete $self->{'original_line'}
		if ref $self;
	return $self;
}

sub as_string {
	my $self = shift;
	
	if (exists $self->{'original_line'}) {
		my $original_line = $self->{'original_line'};
		
		# make sure the line has line_ending, even the original one could be created without using ->new()
		$original_line .= $self->parent->line_ending
			if $original_line !~ m/ \n \Z /xms;
		
		return $original_line;
	}

	my ($key, $value) = ($self->key, $self->value);
	$value = String::Escape::printable($value);

	my $line = join(':', $key, $value);
	
	$line .= $self->parent->line_ending
		if $line !~ m/\n$/xms;
	
	return $line;
}

sub cmp {
	my $a = shift;
	my $b = shift;
	
	$a = $a->as_string if ref $a and $a->can('as_string');
	$b = $b->as_string if ref $b and $b->can('as_string');
	
	return $a cmp $b;
}