view release on metacpan or  search on metacpan

tpnotify  view on Meta::CPAN

    verify_potfile($files{$potfile});
}

# po_header($FILENAME)
# --------------------
# Extract the PO header from the POT file $FILENAME.
# Returns a reference to a hash: header-name => value.
sub po_header {
    my $name = shift;

    (my $h = Locale::PO->load_file_asarray($name)->[0]->msgstr)
	=~ s/^"(.*)"$/$1/;
    my %ret;
    foreach my $s (split /\\n/, $h) {
	if ($s =~ /^(.+?):\s*(.*)$/) {
	    $ret{lc $1}=$2;
	}
    }
    \%ret;
}

# po_serialize($FILENAME)
# -----------------------
# Serializes the pot file in the unambiguous way.
# Extracts the msgids, sorts them lexicographically and concatenates them.
sub po_serialize {
    my $name = shift;
    join("\n", sort map { ($_->msgid // '') . ':' . ($_->msgid_plural // '') } @{Locale::PO->load_file_asarray($name)});
}

# po_cmp($A, $B)
# --------------
# Compares two POT files.  Returns 'true' if the two files contain exactly
# the same set of msgids.
sub po_cmp {
    my ($a,$b) = @_;
    po_serialize($a) eq po_serialize($b);
}

# verify_potfile($FILENAME)
# -------------------------
# Verifies the potfile extracted from the archive.
# Checks if the POT file mentions the correct package string in its
# Project-Id-Version header.  Downloads the POT file registered on the
# TP and makes sure its msgids are not the same as defined in the POT
# file from the archive.
sub verify_potfile {
    my $potname = shift;
    my $hdr = po_header($potname);
    my $vs = $hdr->{'project-id-version'};
    if ($vs ne "$package_name $package_version") {
	err("$potname: Project-Id-Version does not match \"$package_name $package_version\"");
	exit(EX_DATAERR) unless $force_option;
    }

    (my $url = $tp_url) =~ s/\$\{domain\}/$package_tarname/;
    download($url, dest => \my $content);
    if ($content =~ m{$pot_regex_str}) {
	my $tp_potname = download($1);
	if (po_cmp($potname, $tp_potname)) {
	    err("potfile contains no new msgids; no need to upload");
	    exit(0) unless $force_option;
	}
    }
}

# Reads the signature file from $signature_file.
sub read_signature {
    if (defined($signature_file)) {
	if (open(my $fd, '<', $signature_file)) {
	    local $/;
	    chomp(my $sig = <$fd>);
	    close($fd);
	    return $sig;
	}
    }
    return undef;
}

# Expands the message template.
# Returns the expanded text.  Abends on failure.
sub expand_template {
    my $cpt = new Safe;

    $cpt->share(qw($sender
		   $fullname
		   $localdomain
		   $recipient
		   $archive_file
		   $archive_url
		   $package_name
		   $package_version
		   $package_base
		   $release_type
		   $topdir
		   $signature));
    ${$cpt->varglob('signature')} = read_signature;

    (my $tmpl = $template) =~ s/\@/\\\@/g;
    if ($cpt->reval("\$_ = qq{$tmpl}",1)) {
	return $_;
    } else {
	abend(EX_DATAERR, "while expanding template: $@");
    }
}

# Reads the current value of the MH Path setting.
sub read_mh_path {
    my $file = File::Spec->catfile($ENV{HOME}, '.mh_profile');
    if (-f $file) {
	if (open(my $fd, '<', $file)) {
	    my $prev;
	    while (<$fd>) {
		chomp;
		if (s/^\s+//) {
		    $prev .= ' ' . $_;
		} else {
		    last if defined($prev) && $prev =~ /^Path:/;
		    $prev = $_;
		}
	    }