view release on metacpan or  search on metacpan

lib/Locale/PO/Callback.pm  view on Meta::CPAN

	return $char;
    };

    my $unstring = sub {
	my ($str) = @_;
	$str =~ s/^"//;
	$str =~ s/"$//;
	$str =~ s/\\(.)/$escaper->($1)/ge;
	
	return $str;
    };

    my $first = 1;

    my $stanza = $empty_stanza->();

    # Which command a continuation is a continuation of.
    my $continuing = 'msgstr';

    my $handle_stanza = sub {
	if ($first) {

	    if ($stanza->{'msgid'} eq '') {
		# good, that's what we expected
		$stanza->{'type'} = 'header';
		$stanza->{'headers'} = {};
		$stanza->{'header_order'} = [];
		# FIXME allow for continuation lines
		# although nobody ever uses them
		for my $line (split /\n/, $stanza->{'msgstr'}) {
		    $line =~ /^(.*): (.*)$/;
		    $stanza->{'headers'}->{lc $1} = $2;
		    push @{ $stanza->{'header_order'} }, $1;
		}
		delete $stanza->{'msgid'};
		delete $stanza->{'msgstr'};
	    } else {
		# Oh dear, no header.  Fake one.
		$self->{callback}->({
		    type => 'header',
		    headers => {},
		    header_order => [],
				    });
	    }

	    $first = 0;
	} else {
	    $stanza->{'type'} = 'translation';
	    $stanza->{'locations'} = [];
	    $stanza->{'flags'} = {};
	    $stanza->{'comments'} = '' unless defined $stanza->{'comments'};

	    my @comments;

	    for my $comment (split /\n/, $stanza->{'comments'}) {
		if ($comment =~ /^#: (.*):(\d*)$/) {
		    push @{ $stanza->{'locations'} }, [$1, $2];
		} elsif ($comment =~ /^#, (.*)$/) {
		    my $flags = $1;
		    $flags =~ s/\s*,\s*/,/g;
		    for my $flag (split m/,/, $flags) {
			$stanza->{'flags'}->{lc $flag} = 1;
		    }
		} else {
		    push @comments, $comment;
		}
	    }

	    # Anything we didn't handle goes back in the comments field.
	    $stanza->{'comments'} = join("\n", @comments);
	}

	if (defined $stanza->{'msgid'} ||
	    defined $stanza->{'msgstr'} ||
	    defined $stanza->{'msgstr[0]'} ||
	    defined $stanza->{'headers'}
	    ) {
	    $self->{callback}->($stanza);
	}
    };

    while (<PO>) {
	chomp;
	if (/^$/) {
	    $handle_stanza->();
	    $stanza = $empty_stanza->();
	} elsif (/^#/) {
	    $stanza->{comments} .= $_ . "\n";
	} elsif (/^"/) {
	    $stanza->{$continuing} .= $unstring->($_);
	} elsif (/^([^ ]*) (".*)/) {
	    $stanza->{$1} = $unstring->($2);
	    $continuing = $1;
	} else {
	    $self->{callback}->({other => $_, type => 'other'});
	}
    }
    $handle_stanza->();
    close PO or die "Couldn't close $filename: $!";
}

sub create_empty {
    my ($self) = @_;

    my @fields = (
	['Project-Id-Version' => 'PACKAGE VERSION'],
	['PO-Revision-Date' => _today()],
	# FIXME: take this from the environment,
	# if it's available?
	['Last-Translator' => 'FULL NAME <EMAIL@ADDRESS>'],
	['Language-Team' => 'LANGUAGE <LL@li.org>'],
	['MIME-Version' => '1.0'],
	['Content-Type' => 'text/plain; charset=UTF-8'],
	['Content-Transfer-Encoding' => '8bit'],
	);

    my @fieldnames;
    my %fields;

    for (@fields) {
	push @fieldnames, $_->[0];