view release on metacpan or  search on metacpan

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

}

*as_string = *encode;
sub encode {
	my $self  = shift;
	my $lines = shift || (ref $self ? $self->_lines : undef);
	
	# no additional arguments
	if (@_ == 0) {
		my $text = '';
		$self->encode($lines, \$text);
		return $text;
	}
	
	my $any = shift;
	
	my $fh = IO::Any->write($any);
	foreach my $line (@{$lines}) {
		print $fh $line->as_string;
	}
	
	close $fh;
	
	return $self;
}

sub get_fields {
	my $self       = shift;
	my $field_name = shift or croak 'field_name argument is mandatory';
	
	my $key_cmp = $self->key_cmp;
	return (
		grep {
			$key_cmp->($field_name, $_->key) == 0
		} @{$self->_lines}
	);
}

sub get_field {
	my $self       = shift;
	my $field_name = shift or croak 'field_name argument is mandatory';
	my @extra_args = @_;
	
	my @fields = $self->get_fields($field_name, @extra_args);
	croak 'more then one header field with name "'.$field_name.'"'
		if @fields > 1;
	
	return $fields[0];
}

sub get_value {
	my $self = shift;
	my $key  = shift or croak 'key argument is mandatory';
	my @extra_args = @_;

	my $field = $self->get_field($key, @extra_args);
	return undef if not defined $field;
	return $field->value;
}

sub update_values {
	my $self  = shift;
	my $key   = shift or croak 'key argument is mandatory';
	my $value = shift;

	my $key_cmp = $self->key_cmp;
	my @lines = (
		map {
			($key_cmp->($_->key, $key) == 0 ? $_->value($value) : ());
			$_;
		} @{$self->_lines}
	);
	
	return $self;
}

sub rm_fields {
	my $self          = shift;
	my (@field_names) = (@_) or croak 'field_names argument is mandatory';

	my $key_cmp = $self->key_cmp;
	my @lines = (
		grep {
			my $key = $_->key;
			all { $key_cmp->($key, $_) != 0 } @field_names;
		} @{$self->_lines}
	);
	
	$self->_lines(\@lines);
	
	return $self;
}

sub set_value {
	my $self  = shift;
	my $key   = shift or croak 'key argument is mandatory';
	my $value = shift;

	my @fields = $self->get_fields($key);
	if (@fields == 1) {
		$self->update_values($key, $value);
	}
	elsif (@fields == 0) {
		push @{$self->_lines}, Data::Header::Fields::Line->new(
			'key' => $key,
			'value' => $value,
			'parent' => $self,
		);
	}
	else { 
		croak 'more then one header field with name "'.$key.'"';
	}
	
	
	return $self;
}

sub cmp {
	my $a = shift;
	my $b = shift;