our
$VERSION
=
'0.27'
;
sub
new {
my
$this
=
shift
;
my
%options
=
@_
;
my
$class
=
ref
(
$this
) ||
$this
;
my
$self
= {};
bless
$self
,
$class
;
$self
->_flags([]);
$self
->fuzzy_msgid(
$options
{
'-fuzzy_msgid'
})
if
defined
(
$options
{
'-fuzzy_msgid'
});
$self
->fuzzy_msgid_plural(
$options
{
'-fuzzy_msgid_plural'
})
if
defined
(
$options
{
'-fuzzy_msgid_plural'
});
$self
->msgid(
$options
{
'-msgid'
})
if
defined
(
$options
{
'-msgid'
});
$self
->msgid_plural(
$options
{
'-msgid_plural'
})
if
defined
(
$options
{
'-msgid_plural'
});
$self
->msgstr(
$options
{
'-msgstr'
})
if
defined
(
$options
{
'-msgstr'
});
$self
->msgstr_n(
$options
{
'-msgstr_n'
})
if
defined
(
$options
{
'-msgstr_n'
});
$self
->msgctxt(
$options
{
'-msgctxt'
})
if
defined
(
$options
{
'-msgctxt'
});
$self
->fuzzy_msgctxt(
$options
{
'-fuzzy_msgctxt'
})
if
defined
(
$options
{
'-fuzzy_msgctxt'
});
$self
->comment(
$options
{
'-comment'
})
if
defined
(
$options
{
'-comment'
});
$self
->fuzzy(
$options
{
'-fuzzy'
})
if
defined
(
$options
{
'-fuzzy'
});
$self
->automatic(
$options
{
'-automatic'
})
if
defined
(
$options
{
'-automatic'
});
$self
->reference(
$options
{
'-reference'
})
if
defined
(
$options
{
'-reference'
});
$self
->c_format(1)
if
defined
(
$options
{
'-c-format'
});
$self
->c_format(1)
if
defined
(
$options
{
'-c_format'
});
$self
->c_format(0)
if
defined
(
$options
{
'-no-c-format'
});
$self
->c_format(0)
if
defined
(
$options
{
'-no_c_format'
});
$self
->loaded_line_number(
$options
{
'-loaded_line_number'
})
if
defined
(
$options
{
'-loaded_line_number'
});
return
$self
;
}
sub
fuzzy_msgctxt {
my
$self
=
shift
;
@_
?
$self
->{
'fuzzy_msgctxt'
} =
$self
->quote(
shift
) :
$self
->{
'fuzzy_msgctxt'
};
}
sub
fuzzy_msgid {
my
$self
=
shift
;
@_
?
$self
->{
'fuzzy_msgid'
} =
$self
->quote(
shift
) :
$self
->{
'fuzzy_msgid'
};
}
sub
fuzzy_msgid_plural {
my
$self
=
shift
;
@_
?
$self
->{
'fuzzy_msgid_plural'
} =
$self
->quote(
shift
)
:
$self
->{
'fuzzy_msgid_plural'
};
}
sub
msgctxt {
my
$self
=
shift
;
@_
?
$self
->{
'msgctxt'
} =
$self
->quote(
shift
) :
$self
->{
'msgctxt'
};
}
sub
msgid {
my
$self
=
shift
;
@_
?
$self
->{
'msgid'
} =
$self
->quote(
shift
) :
$self
->{
'msgid'
};
}
sub
msgid_plural {
my
$self
=
shift
;
@_
?
$self
->{
'msgid_plural'
} =
$self
->quote(
shift
)
:
$self
->{
'msgid_plural'
};
}
sub
msgstr {
my
$self
=
shift
;
@_
?
$self
->{
'msgstr'
} =
$self
->quote(
shift
) :
$self
->{
'msgstr'
};
}
sub
msgstr_n {
my
$self
=
shift
;
if
(
@_
) {
my
$hashref
=
shift
;
croak
'Argument to msgstr_n must be a hashref: { n => "string n", ... }.'
unless
ref
(
$hashref
) eq
'HASH'
;
croak
'Keys to msgstr_n hashref must be numbers'
if
grep
{m/\D/}
keys
%$hashref
;
$self
->{
'msgstr_n'
}{
$_
} =
$self
->quote(
$$hashref
{
$_
})
for
keys
%$hashref
;
}
return
$self
->{
'msgstr_n'
};
}
sub
comment {
my
$self
=
shift
;
@_
?
$self
->{
'comment'
} =
shift
:
$self
->{
'comment'
};
}
sub
automatic {
my
$self
=
shift
;
@_
?
$self
->{
'automatic'
} =
shift
:
$self
->{
'automatic'
};
}
sub
reference {
my
$self
=
shift
;
@_
?
$self
->{
'reference'
} =
shift
:
$self
->{
'reference'
};
}
sub
obsolete {
my
$self
=
shift
;
@_
?
$self
->{
'obsolete'
} =
shift
:
$self
->{
'obsolete'
};
}
sub
fuzzy {
my
$self
=
shift
;
if
(
@_
) {
my
$value
=
shift
;
$value
?
$self
->add_flag(
'fuzzy'
) :
$self
->remove_flag(
'fuzzy'
);
}
return
$self
->has_flag(
'fuzzy'
);
}
sub
c_format {
my
$self
=
shift
;
return
$self
->_tri_value_flag(
'c-format'
,
@_
);
}
sub
php_format {
my
$self
=
shift
;
return
$self
->_tri_value_flag(
'php-format'
,
@_
);
}
sub
_flags {
my
$self
=
shift
;
@_
?
$self
->{
'_flags'
} =
shift
:
$self
->{
'_flags'
};
}
sub
_tri_value_flag {
my
$self
=
shift
;
my
$flag_name
=
shift
;
if
(
@_
) {
my
$value
=
shift
;
if
(!
defined
(
$value
) ||
$value
eq
""
) {
$self
->remove_flag(
"$flag_name"
);
$self
->remove_flag(
"no-$flag_name"
);
return
undef
;
}
elsif
(
$value
) {
$self
->add_flag(
"$flag_name"
);
$self
->remove_flag(
"no-$flag_name"
);
return
1;
}
else
{
$self
->add_flag(
"no-$flag_name"
);
$self
->remove_flag(
"$flag_name"
);
return
0;
}
}
else
{
return
1
if
$self
->has_flag(
"$flag_name"
);
return
0
if
$self
->has_flag(
"no-$flag_name"
);
return
undef
;
}
}
sub
add_flag {
my
(
$self
,
$flag_name
) =
@_
;
if
(!
$self
->has_flag(
$flag_name
)) {
push
@{
$self
->_flags},
$flag_name
;
}
return
;
}
sub
remove_flag {
my
(
$self
,
$flag_name
) =
@_
;
my
@new_flags
;
foreach
my
$flag
(@{
$self
->_flags}) {
push
@new_flags
,
$flag
unless
$flag
eq
$flag_name
;
}
$self
->_flags(\
@new_flags
);
return
;
}
sub
has_flag {
my
(
$self
,
$flag_name
) =
@_
;
foreach
my
$flag
(@{
$self
->_flags}) {
return
1
if
$flag
eq
$flag_name
;
}
return
;
}
sub
loaded_line_number {
my
$self
=
shift
;
@_
?
$self
->{
'loaded_line_number'
} =
shift
:
$self
->{
'loaded_line_number'
};
}
sub
_normalize_str {
my
$self
=
shift
;
my
$string
=
shift
;
my
$dequoted
=
$self
->dequote(
$string
);
if
(
defined
$dequoted
&&
$dequoted
=~ /\n/) {
my
$output
;
my
@lines
;
@lines
=
split
(/\n/,
$dequoted
, -1);
my
$lastline
=
pop
@lines
;
$output
=
qq{""\n}
if
(
$#lines
!= 0);
foreach
(
@lines
) {
$output
.=
$self
->quote(
"$_\n"
) .
"\n"
;
}
$output
.=
$self
->quote(
$lastline
) .
"\n"
if
$lastline
ne
""
;
return
$output
;
}
else
{
return
(
$string
||
""
) .
"\n"
;
}
}
sub
_fuzzy_normalize_str {
my
$self
=
shift
;
my
$string
=
shift
;
my
$prefix
=
shift
;
my
$normalized
=
$self
->_normalize_str(
$string
);
$normalized
=~ s/\n
"/\n$prefix"
/g;
return
$normalized
;
}
sub
dump
{
my
$self
=
shift
;
my
$obsolete
=
$self
->obsolete ?
'#~ '
:
''
;
my
$fuzzy_prefix
=
$self
->obsolete ?
'#~| '
:
'#| '
;
my
$dump
;
$dump
=
$self
->_dump_multi_comment(
$self
->comment,
"# "
)
if
(
$self
->comment);
$dump
.=
$self
->_dump_multi_comment(
$self
->automatic,
"#. "
)
if
(
$self
->automatic);
$dump
.=
$self
->_dump_multi_comment(
$self
->reference,
"#: "
)
if
(
$self
->reference);
my
$flags
=
''
;
foreach
my
$flag
(@{
$self
->_flags}) {
$flags
.=
", $flag"
;
}
$dump
.=
"#$flags\n"
if
length
$flags
;
$dump
.=
"${fuzzy_prefix}msgctxt "
.
$self
->_fuzzy_normalize_str(
$self
->fuzzy_msgctxt,
$fuzzy_prefix
)
if
$self
->fuzzy_msgctxt;
$dump
.=
"${fuzzy_prefix}msgid "
.
$self
->_fuzzy_normalize_str(
$self
->fuzzy_msgid,
$fuzzy_prefix
)
if
$self
->fuzzy_msgid;
$dump
.=
"${fuzzy_prefix}msgid_plural "
.
$self
->_fuzzy_normalize_str(
$self
->fuzzy_msgid_plural,
$fuzzy_prefix
)
if
$self
->fuzzy_msgid_plural;
$dump
.=
"${obsolete}msgctxt "
.
$self
->_normalize_str(
$self
->msgctxt)
if
$self
->msgctxt;
$dump
.=
"${obsolete}msgid "
.
$self
->_normalize_str(
$self
->msgid);
$dump
.=
"${obsolete}msgid_plural "
.
$self
->_normalize_str(
$self
->msgid_plural)
if
$self
->msgid_plural;
$dump
.=
"${obsolete}msgstr "
.
$self
->_normalize_str(
$self
->msgstr)
if
$self
->msgstr;
if
(
my
$msgstr_n
=
$self
->msgstr_n) {
$dump
.=
"${obsolete}msgstr[$_] "
.
$self
->_normalize_str(
$$msgstr_n
{
$_
})
for
sort
{
$a
<=>
$b
}
keys
%$msgstr_n
;
}
$dump
.=
"\n"
;
return
$dump
;
}
sub
_dump_multi_comment {
my
$self
=
shift
;
my
$comment
=
shift
;
my
$leader
=
shift
;
my
$chopped
=
$leader
;
chop
(
$chopped
);
my
$result
=
$leader
.
$comment
;
$result
=~ s/\n/\n
$leader
/g;
$result
=~ s/^
$leader
$/
$chopped
/gm;
$result
.=
"\n"
;
return
$result
;
}
sub
quote {
my
$self
=
shift
;
my
$string
=
shift
;
return
undef
unless
defined
$string
;
$string
=~ s/\\(?!t)/\\\\/g;
$string
=~ s/
"/\\"
/g;
$string
=~ s/\n/\\n/g;
return
"\"$string\""
;
}
sub
dequote {
my
$self
=
shift
;
my
$string
=
shift
;
return
undef
unless
defined
$string
;
$string
=~ s/^
"(.*)"
/$1/;
$string
=~ s/\\
"/"
/g;
$string
=~ s/(?<!(\\))\\n/\n/g;
$string
=~ s/(?<!(\\))\\{2}n/\\n/g;
$string
=~ s/(?<!(\\))\\{3}n/\\\n/g;
$string
=~ s/\\{4}n/\\\\n/g;
$string
=~ s/\\\\(?!n)/\\/g;
return
$string
;
}
sub
save_file_fromarray {
my
$self
=
shift
;
$self
->_save_file(0,
@_
);
}
sub
save_file_fromhash {
my
$self
=
shift
;
$self
->_save_file(1,
@_
);
}
sub
_save_file {
my
$self
=
shift
;
my
$ashash
=
shift
;
my
$file
=
shift
;
my
$entries
=
shift
;
my
$encoding
=
shift
;
open
(OUT,
defined
(
$encoding
) ?
">:encoding($encoding)"
:
">"
,
$file
)
or
return
undef
;
if
(
$ashash
) {
foreach
(
sort
keys
%$entries
) {
print
OUT
$entries
->{
$_
}->
dump
;
}
}
else
{
foreach
(
@$entries
) {
print
OUT
$_
->
dump
;
}
}
close
OUT;
}
sub
load_file_asarray {
my
$self
=
shift
;
$self
->_load_file(0,
@_
);
}
sub
load_file_ashash {
my
$self
=
shift
;
$self
->_load_file(1,
@_
);
}
sub
_load_file {
my
$self
=
shift
;
my
$ashash
=
shift
;
my
$file
=
shift
;
my
$encoding
=
shift
;
my
$class
=
ref
$self
||
$self
;
my
(
@entries
,
%entries
);
my
$line_number
= 0;
my
$po
;
my
%buffer
;
my
$last_buffer
;
open
(IN,
defined
(
$encoding
) ?
"<:encoding($encoding)"
:
"<"
,
$file
)
or
return
undef
;
while
(<IN>) {
chomp
;
$line_number
++;
s{[\r\n]*$}{};
if
(/^$/) {
if
(
defined
(
$po
)) {
$po
->fuzzy_msgctxt(
$buffer
{fuzzy_msgctxt})
if
defined
$buffer
{fuzzy_msgctxt};
$po
->fuzzy_msgid(
$buffer
{fuzzy_msgid})
if
defined
$buffer
{fuzzy_msgid};
$po
->fuzzy_msgid_plural(
$buffer
{fuzzy_msgid_plural})
if
defined
$buffer
{fuzzy_msgid_plural};
$po
->msgctxt(
$buffer
{msgctxt})
if
defined
$buffer
{msgctxt};
$po
->msgid(
$buffer
{msgid})
if
defined
$buffer
{msgid};
$po
->msgid_plural(
$buffer
{msgid_plural})
if
defined
$buffer
{msgid_plural};
$po
->msgstr(
$buffer
{msgstr})
if
defined
$buffer
{msgstr};
$po
->msgstr_n(
$buffer
{msgstr_n})
if
defined
$buffer
{msgstr_n};
if
(
$ashash
) {
$entries
{
$po
->msgid} =
$po
if
(
$po
->_hash_key_ok(\
%entries
));
}
else
{
push
(
@entries
,
$po
);
}
undef
$po
;
undef
$last_buffer
;
%buffer
= ();
}
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
if
(
defined
(
$po
->comment)) {
$po
->comment(
$po
->comment .
"\n$1"
);
}
else
{
$po
->comment($1);
}
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
if
(
defined
(
$po
->automatic)) {
$po
->automatic(
$po
->automatic .
"\n$1"
);
}
else
{
$po
->automatic($1);
}
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
if
(
defined
(
$po
->reference)) {
$po
->reference(
$po
->reference .
"\n$1"
);
}
else
{
$po
->reference($1);
}
}
elsif
(/^
my
@flags
=
split
/\s*[,]\s*/, $1;
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
foreach
my
$flag
(
@flags
) {
$po
->add_flag(
$flag
);
}
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{fuzzy_msgctxt} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{fuzzy_msgctxt};
$po
->obsolete(1)
if
$1;
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{fuzzy_msgid} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{fuzzy_msgid};
$po
->obsolete(1)
if
$1;
}
elsif
(/^
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{fuzzy_msgid_plural} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{fuzzy_msgid_plural};
$po
->obsolete(1)
if
$1;
}
elsif
(/^(
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{msgctxt} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{msgctxt};
$po
->obsolete(1)
if
$1;
}
elsif
(/^(
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{msgid} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{msgid};
$po
->obsolete(1)
if
$1;
}
elsif
(/^(
$po
=
$class
->new(
-loaded_line_number
=>
$line_number
)
unless
defined
(
$po
);
$buffer
{msgid_plural} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{msgid_plural};
$po
->obsolete(1)
if
$1;
}
elsif
(/^(?:
$buffer
{msgstr} =
$self
->dequote($1);
$last_buffer
= \
$buffer
{msgstr};
}
elsif
(/^(?:
$buffer
{msgstr_n}{$1} =
$self
->dequote($2);
$last_buffer
= \
$buffer
{msgstr_n}{$1};
}
elsif
(/^(?:
$$last_buffer
.=
$self
->dequote($1);
}
else
{
warn
"Strange line at $file line $line_number: [$_]\n"
;
}
}
if
(
defined
(
$po
)) {
$po
->msgctxt(
$buffer
{msgctxt})
if
defined
$buffer
{msgctxt};
$po
->msgid(
$buffer
{msgid})
if
defined
$buffer
{msgid};
$po
->msgid_plural(
$buffer
{msgid_plural})
if
defined
$buffer
{msgid_plural};
$po
->msgstr(
$buffer
{msgstr})
if
defined
$buffer
{msgstr};
$po
->msgstr_n(
$buffer
{msgstr_n})
if
defined
$buffer
{msgstr_n};
if
(
$ashash
) {
if
(
$po
->_hash_key_ok(\
%entries
)) {
$entries
{
$po
->msgid} =
$po
;
}
}
else
{
push
(
@entries
,
$po
);
}
}
close
IN;
return
(
$ashash
? \
%entries
: \
@entries
);
}
sub
_hash_key_ok {
my
(
$self
,
$entries
) =
@_
;
my
$key
=
$self
->msgid;
if
(
$entries
->{
$key
}) {
return
if
((
$self
->obsolete) && (not
$entries
->{
$key
}->obsolete));
return
if
((
$self
->msgstr !~ /\w/) && (
$entries
->{
$key
}->msgstr =~ /\w/));
}
return
1;
}
1;