Skip to content
Snippets Groups Projects
get_maintainer.pl 54.1 KiB
Newer Older
  • Learn to ignore specific revisions
  • sub clean_file_emails {
        my (@file_emails) = @_;
        my @fmt_emails = ();
    
        foreach my $email (@file_emails) {
    	$email =~ s/[\(\<\{]{0,1}([A-Za-z0-9_\.\+-]+\@[A-Za-z0-9\.-]+)[\)\>\}]{0,1}/\<$1\>/g;
    	my ($name, $address) = parse_email($email);
    	if ($name eq '"[,\.]"') {
    	    $name = "";
    	}
    
    	my @nw = split(/[^A-Za-zÀ-ÿ\'\,\.\+-]/, $name);
    	if (@nw > 2) {
    	    my $first = $nw[@nw - 3];
    	    my $middle = $nw[@nw - 2];
    	    my $last = $nw[@nw - 1];
    
    	    if (((length($first) == 1 && $first =~ m/[A-Za-z]/) ||
    		 (length($first) == 2 && substr($first, -1) eq ".")) ||
    		(length($middle) == 1 ||
    		 (length($middle) == 2 && substr($middle, -1) eq "."))) {
    		$name = "$first $middle $last";
    	    } else {
    		$name = "$middle $last";
    	    }
    	}
    
    	if (substr($name, -1) =~ /[,\.]/) {
    	    $name = substr($name, 0, length($name) - 1);
    	} elsif (substr($name, -2) =~ /[,\.]"/) {
    	    $name = substr($name, 0, length($name) - 2) . '"';
    	}
    
    	if (substr($name, 0, 1) =~ /[,\.]/) {
    	    $name = substr($name, 1, length($name) - 1);
    	} elsif (substr($name, 0, 2) =~ /"[,\.]/) {
    	    $name = '"' . substr($name, 2, length($name) - 2);
    	}
    
    	my $fmt_email = format_email($name, $address, $email_usename);
    	push(@fmt_emails, $fmt_email);
        }
        return @fmt_emails;
    }
    
    
    sub merge_email {
        my @lines;
        my %saw;
    
        for (@_) {
    	my ($address, $role) = @$_;
    	if (!$saw{$address}) {
    	    if ($output_roles) {
    
    		push(@lines, "$address ($role)");
    
    sub output {
    
    
        if ($output_multiline) {
    	foreach my $line (@parms) {
    	    print("${line}\n");
    	}
        } else {
    	print(join($output_separator, @parms));
    	print("\n");
        }
    }
    
    
    my $rfc822re;
    
    sub make_rfc822re {
    #   Basic lexical tokens are specials, domain_literal, quoted_string, atom, and
    #   comment.  We must allow for rfc822_lwsp (or comments) after each of these.
    #   This regexp will only work on addresses which have had comments stripped
    #   and replaced with rfc822_lwsp.
    
        my $specials = '()<>@,;:\\\\".\\[\\]';
        my $controls = '\\000-\\037\\177';
    
        my $dtext = "[^\\[\\]\\r\\\\]";
        my $domain_literal = "\\[(?:$dtext|\\\\.)*\\]$rfc822_lwsp*";
    
        my $quoted_string = "\"(?:[^\\\"\\r\\\\]|\\\\.|$rfc822_lwsp)*\"$rfc822_lwsp*";
    
    #   Use zero-width assertion to spot the limit of an atom.  A simple
    #   $rfc822_lwsp* causes the regexp engine to hang occasionally.
        my $atom = "[^$specials $controls]+(?:$rfc822_lwsp+|\\Z|(?=[\\[\"$specials]))";
        my $word = "(?:$atom|$quoted_string)";
        my $localpart = "$word(?:\\.$rfc822_lwsp*$word)*";
    
        my $sub_domain = "(?:$atom|$domain_literal)";
        my $domain = "$sub_domain(?:\\.$rfc822_lwsp*$sub_domain)*";
    
        my $addr_spec = "$localpart\@$rfc822_lwsp*$domain";
    
        my $phrase = "$word*";
        my $route = "(?:\@$domain(?:,\@$rfc822_lwsp*$domain)*:$rfc822_lwsp*)";
        my $route_addr = "\\<$rfc822_lwsp*$route?$addr_spec\\>$rfc822_lwsp*";
        my $mailbox = "(?:$addr_spec|$phrase$route_addr)";
    
        my $group = "$phrase:$rfc822_lwsp*(?:$mailbox(?:,\\s*$mailbox)*)?;\\s*";
        my $address = "(?:$mailbox|$group)";
    
        return "$rfc822_lwsp*$address";
    }
    
    sub rfc822_strip_comments {
        my $s = shift;
    #   Recursively remove comments, and replace with a single space.  The simpler
    #   regexps in the Email Addressing FAQ are imperfect - they will miss escaped
    #   chars in atoms, for example.
    
        while ($s =~ s/^((?:[^"\\]|\\.)*
                        (?:"(?:[^"\\]|\\.)*"(?:[^"\\]|\\.)*)*)
                        \((?:[^()\\]|\\.)*\)/$1 /osx) {}
        return $s;
    }
    
    #   valid: returns true if the parameter is an RFC822 valid address
    #
    
    sub rfc822_valid {
    
        my $s = rfc822_strip_comments(shift);
    
        if (!$rfc822re) {
            $rfc822re = make_rfc822re();
        }
    
        return $s =~ m/^$rfc822re$/so && $s =~ m/^$rfc822_char*$/;
    }
    
    #   validlist: In scalar context, returns true if the parameter is an RFC822
    #              valid list of addresses.
    #
    #              In list context, returns an empty list on failure (an invalid
    #              address was found); otherwise a list whose first element is the
    #              number of addresses found and whose remaining elements are the
    #              addresses.  This is needed to disambiguate failure (invalid)
    #              from success with no addresses found, because an empty string is
    #              a valid list.
    
    
    sub rfc822_validlist {
    
        my $s = rfc822_strip_comments(shift);
    
        if (!$rfc822re) {
            $rfc822re = make_rfc822re();
        }
        # * null list items are valid according to the RFC
        # * the '1' business is to aid in distinguishing failure from no results
    
        my @r;
        if ($s =~ m/^(?:$rfc822re)?(?:,(?:$rfc822re)?)*$/so &&
    	$s =~ m/^$rfc822_char*$/) {
    
            while ($s =~ m/(?:^|,$rfc822_lwsp*)($rfc822re)/gos) {