package header;

# Takes two arguments, a starting line (with its newline) and a
# file handle to read further strings from.  The starting string
# should be undef if there is none.
# 
# Returns the first line of the next section, if any, with its
# newline, and an associative array of header field names and values.
# 
# Upon return, $header'text_read contains all of the text that was
# read, including any starting string passed in, but not including
# the first line of the next section (which is returned, as described
# above).
# 
# If @header'error_fields has elements when the function returns, then
# it contains a list of fields which had errors in them, including the
# following errors:
# 
# * Continuation line(s) at the start of the header.
# * Fields without whitespace after the colon.
# * Fields with whitespace before the colon.
# * Fields without a colon.
# 
# These fields will not appear in the associative array.
# 
# If $header'require_colon_space is set to false, fields missing
# whitespace after the colon will not cause an error.
# 
# If $header'prohibit_field_space is set to false, fields with
# whitespace before the colon will not cause an error (although fields
# with newlines before the colon still will).

$require_colon_space = 1;
$prohibit_field_space = 1;

sub parse {
    local($current, $fhandle) = @_;
    local($/) = "\n";
    local($*) = undef;
    local($header, $more_text, @headers, %headers, $fieldname);
    local($next_line);
    local($_);

    $fhandle = "$package'" . $fhandle if ($fhandle !~ /\'/);

    $header = $text_read = $current;
    @error_fields = ();

    
    while (<$fhandle>) {
	$text_read .= $_;
	last if (/^$/);
	$header .= $_;
    }

DEAL_WITH_EXTRA_PAR:		# Temporary, added by jmorzins
    if ($header =~ /Reposting article removed by rogue/) {
	while (<$fhandle>) {
	    $text_read .= $_;
	    last if (/^$/);
	    $header .= $_;
	}
    }

    $more_text = 1 if ($_);
    $current = undef;

    # This is a totally cool way to split a mail header into its
    # components.
    #    @headers = split(/\n\b/, $header);
    #
    # But it fails when the message was MIME-encoded (since a leading
    # F becomes =46 and = apparently isn't a word boundary), so...

    $count = $[ - 1;
    for (split(/\n/, $header)) {
	$count++ unless (/^\s/);
	if (count>0) { # without this, dies if first line starts w/space
	    @headers[$count] .= $_ . "\n";
	}
    }

    # Make sure every field has exactly one newline at the end of it.
    @headers = grep(s/\n*$/\n/, @headers);

    # Check if there are any continuation lines at the beginning of
    # the header.  If so, put them in @error_fields.
    push(@error_fields, shift @headers) if ($headers[0] =~ /^[ \t]/);

    for (@headers) {
	if ($prohibit_field_space && /^[^:]*[ \t\n]/) {
	    # Whitespace before the colon.
	    push(@error_fields, $_);
	    next;
	}
	elsif ($require_colon_space && /^[^:\n]+:[^ \t]/) {
	    # No whitespace after the colon.
	    push(@error_fields, $_);
	    next;
	}
	elsif (! /^([^:\n]+):/) {
	    # No colon on the first line.
	    push(@error_fields, $_);
	    next;
	}
	else {
	    # Valid field.
	    ($fieldname = $1) =~ tr/A-Z/a-z/;
	    $headers{$fieldname} .= $_;
	}
    }

    # Read all the blank lines at the end of the header, and find the
    # first line in the next section.
    if ($more_text) {
	$/ = "\n";
	while ($current = <$fhandle>) {
	    last if ($current =~ /./);
	}
    }

    return($current, %headers);
}



    
sub print {
    local($fhandle, %headers) = @_;
    local($key);

    foreach $key (keys(%headers)) {
	print $fhandle "$headers{$key}";
    }
}

sub field_exists {
    local($field, %headers) = @_;

    $field =~ tr/A-Z/a-z/;
    $headers{$field};
}

sub field_value {
    local($field, %headers) = @_;
    local($*) = 1;

    $field =~ tr/A-Z/a-z/;
    $field = $headers{$field};

    return $field if (!$field);

    chop $field;

    if ($field =~ /\n[^ \t]/) {
	# There are multiple instances of this field in the header;
 	# that's not allowed when using field_value
	return undef;
    }

    $field =~ s/^[^ \t]+:[ \t]*//;
    $field =~ s/\s+$//;
    return($field);
}

sub set_field {
    local($field, $value, *headers) = @_;
    local($newfield) = $field;

    $newfield =~ tr/A-Z/a-z/;

    $headers{$newfield} = "$field: $value\n";
}

sub delete_field {
    local($field, *headers) = @_;

    $field =~ tr/A-Z/a-z/;
    delete $headers{$field};
}

sub is_multiple {
    local($field, %headers) = @_;

    $field =~ tr/A-Z/a-z/;
    $field = $headers{$field};

    $field && ($field =~ /\n[^ \t]/);
}

1;