summaryrefslogtreecommitdiffstats
path: root/po/pl_create_placeholder
diff options
context:
space:
mode:
Diffstat (limited to 'po/pl_create_placeholder')
-rwxr-xr-xpo/pl_create_placeholder509
1 files changed, 0 insertions, 509 deletions
diff --git a/po/pl_create_placeholder b/po/pl_create_placeholder
deleted file mode 100755
index f1a07a7f..00000000
--- a/po/pl_create_placeholder
+++ /dev/null
@@ -1,509 +0,0 @@
-#!/usr/bin/perl
-
-# modified xplgettext from perl-gettext (pablo)
-
-# this program extracts internationalizable strings from a perl program.
-
-# forward declaration of subroutines.
-sub unescapeDQString;
-sub replaceString($$$$);
-sub doWarn($$);
-sub displayHelp();
-sub doNotify($);
-
-
-# we do the option handling first.
-use Getopt::Long;
-Getopt::Long::config("no_ignore_case",
- "no_auto_abbrev",
- "require_order",
- "bundling");
-# since get options doesn't seem to handle '-' as option well,
-# we'll preprocess here
-foreach $i (0 ... $#ARGV)
-{
- if($opt eq '-')
- {
- $ARGV[$i] = '__stdin__';
- }
-}
-
-if(!GetOptions(\%opts,
-# 'default-domain|d=s',
-# 'directory|D=s',
-# 'no-escape|e',
-# 'escape|E',
-# 'files-from=s',
-# 'sort-by-file|F',
-# 'help|h',
-# 'indent|i',
-# 'join-existing|j',
-# 'keyword|k:s@',
-# 'string-limit|l=i',
-# 'msgstr-prefix|m:s',
-# 'msgstr-suffix|M:s',
-# 'no-location',
-# 'add-location|n',
-# 'omit-header',
-# 'sort-output|s',
-# 'strict',
- 'verbose|v',
-# 'version|V',
-# 'exclude-file|x=s'
- ) || defined($opts{"help"}))
-{
- displayHelp;
-}
-
-# check if we have any file names to deal with.
-if($#ARGV == -1)
-{
- doWarn 1, 'File name not specified. Standard in is used instead.';
- push @ARGV, '__stdin__';
-}
-
-
-# keeps track of the state of the parser. basically means what we are
-# looking for next.
-$state = 'func_head';
-
-# initialize the text temporarry strage.
-$text = "";
-
-# repeat for all the lines.
-for($i = 0; $i <= $#ARGV; $i++)
-{
- # this keeps track of the line number.
- $linenum = 0;
-
- # open the file. we take '__stdin__' as standard in.
- $ARGV[$i] = '-' if $ARGV[$i] eq '__stdin__';
- if(!open(IN, "< $ARGV[$i]"))
- {
- # failed to open the file.
- doWarn 0, "Failed to open input file $ARGV[$i].";
- next;
- }
- doNotify "File $ARGV[$i] opened.";
-
- # keep track of the files successfully opened.
- push @files, $ARGV[$i];
-
- while(<IN>)
- {
- $linenum++;
-
- # discard the comment lines.
- if(/^\s*\#/)
- {
- next;
- }
-
- # our assumption is that 'I_(' won't appear anywhere other than where
- # internationalizable text is being marked.
- chop;
- $line = $_;
- while ($line)
- {
- if($state eq 'func_head')
- {
- # this means we are looking for the beginning of funciton call.
- #if($line =~ s/.*?I\_\(//)
- if($line =~ s/.*?\_\(//)
- {
- $state = 'quote_begin';
- next;
- }
-
- # nothing interesting in this line.
- last;
- }
-
- elsif($state eq 'quote_begin')
- {
- # we are looking for left quote. there can be two of them.
- if($line =~ s/^\s*([\"\'])//)
- {
- # this has to happen. check what kind of quoting we have.
- $start_line = $linenum;
- if($1 eq '"')
- {
- $state = 'dq_text';
- }
- else
- {
- $state = 'sq_text';
- }
- }
- else
- {
- # otherwise, this is something we can't handle.
- doWarn 1, "Unrecognizable expression within I_" .
- " function call. (line: $linenum)";
- $state = 'dynamic_text';
- }
-
- # lines can't end in this state.
- next;
- }
-
- elsif($state eq 'dq_text')
- {
- # we are only interested in another double quote which is not
- # preceded by a back slash.
- if($line =~ s/(.*?)\"//)
- {
- # check if we have a back slash preceding it.
- $t = $1;
- if($t =~ /\\$/)
- {
- # the double quote was within the string still.
- $text .= unescapeDQString($t . '"');
- }
- else
- {
- # end of the string.
- $text .= unescapeDQString($t);
- $state = 'end_text';
- }
- next;
- }
-
- # all this line is the string.
- $text .= unescapeDQString($line . '\n');
- last;
- }
-
- elsif($state eq 'sq_text')
- {
- # we are only interested in another single quote which is not
- # preceded by a back slash.
- if($line =~ s/(.*?)\'//)
- {
- # check if we have a back slash preceding it.
- $t = $1;
- if($t =~ s/\\$//)
- {
- # the single quote was still in the string.
- $text .= unescapeDQString($t . "'");
- }
- else
- {
- # end of the string.
- $text .= unescapeDQString($t);
- $state = 'end_text';
- }
- next;
- }
-
- # all this line is the string.
- $text .= unescapeDQStrig($line . '\n');
- last;
- }
-
- elsif($state eq 'dynamic_text')
- {
- # we can't really handle this situation, so we'll look for
- # a close pharenthy to return to the normal state.
- if($line =~ s/.*?\)//)
- {
- # we can go back to the normal state.
- $state = 'func_head';
- next;
- }
-
- # we have to find the close pharenthy to go
- # back to the normal state.
- last;
- }
-
- elsif($state eq 'end_text')
- {
- # we allow only period to appear between strings.
- if($line =~ s/^\s*([\.\),])//)
- {
- # check what we've got.
- if($1 eq '.')
- {
- # another string should be comming.
- $state = 'quote_begin';
- }
- else
- {
- # we ended the function call.
- $state = 'func_head';
-
- # check if the string is a valid one.
- if($text eq "")
- {
- # we don't accept null strings.
- doWarn 1, "Null string appeared. (line: $linenum)";
- }
- else
- {
- # check if this string has appeared before.
- if(exists($msgs{$text}))
- {
- # it does exit.
- $msgs{$text} .= " $ARGV[$i]:$start_line";
- }
- else
- {
- # first time.
- $msgs{$text} = "$ARGV[$i]:$start_line";
- }
- $text = "";
- }
- }
- next;
- }
- else
- {
- # something weird follows the text.
- # in this case, we ignore the string processed too.
- doWarn 1, 'Unrecognizable expression within I_' .
- " function call. (line: $linenum)";
- $text = "";
- $state = 'dynamic_text';
- next;
- }
- }
-
- else
- {
- # this should not happen.
- doWarn 2, "Unknown state $state.";
- last;
- }
-
- # end of while loop for state processing.
- }
- # end of while loop for input lines.
- }
- # end of for loop for input files.
-}
-
-
-# we should have all the data we need now.
-# output the message file.
-if(!open(OUT, ">&STDOUT"))
-{
- doWarn 0, 'Failed to open file placeholder.h.';
- exit(0);
-}
-
-# go through all the strings gathered.
-foreach $msgid (keys(%msgs))
-{
- # we find out if the text has to be split into lines.
- $#lines = - 1;
- while($msgid =~ /(.*?\\n)/gc)
- {
- push @lines, $1;
- }
- if(pos($msgid) < length($msgid))
- {
- # we have another line.
- push @lines, substr($msgid, pos($msgid));
- }
-
- # check how many lines we have.
- if($#lines == 0)
- {
- my $fuck_dblquote = $lines[0]; $fuck_dblquote =~ s/\"/\\\"/g;
- # one line format.
- print OUT "N_(\"$fuck_dblquote\"),\n";
- }
- else
- {
- # multi-line format.
- print OUT "N_(\"\"\n";
- foreach $line (@lines)
- {
- my $fuck_dblquote = $line; $fuck_dblquote =~ s/\"/\\\"/g;
- print OUT "\"$fuck_dblquote\"\n";
- }
- print OUT "\"\"),\n";
- }
-}
-
-
-# successfully completed the mission.
-exit 0;
-
-
-######################################################################
-# helper funciton section
-######################################################################
-
-# this function has to return a value, so it doesn't deserve
-# the statement style call, and therefore doesn't deserve prototype.
-sub unescapeDQString
-{
- my $str = shift;
-
- # check all the back slashes.
- while($str =~ /\\/g)
- {
- # we found a back slash. let's check what the following
- # character is.
- my $char = substr($str, pos($str));
-
- if($char eq '')
- {
- # since we assume one call of this function is for one
- # complete string (term in string expression), we
- # assume we don't have to worry about escape sequences
- # span multiple calls.
-
- # it was the last character in the string. this shouldn't
- # happen, but we respect the back slash.
- doWarn 2, "Back slash found at the end of string. (line: $lnenum)";
- $str .= '\\';
- last;
- }
-
- elsif($char =~ /^([tn]|[0-8][0-8][0-8])/)
- {
- # valid sequence. no problem.
- next;
- }
-
- elsif($char =~ /^[rfb]/)
- {
- # we warn, and use them as is.
- doWarn 1, "International string sholdn't contain \\$&.";
- next;
- }
-
- elsif($char =~ /^[ae]/)
- {
- # we warn, and convert.
- doWarn 1, "International string shouldn't contain \\$&.";
- replaceString \$str, $& eq 'a' ? '007' : '033', 0, 1;
- next;
- }
-
- elsif($char =~ /^x([0-9a-fA-F][0-9a-fA-F])/)
- {
- # here, we do the conversion silently.
- replaceString \$str, sprintf("%03o", hex($1)), 0, 3;
- next;
- }
-
- elsif($char =~ /^c(.)/)
- {
- # we warn, and convert.
- doWarn 1, "International string shouldn't contain \\$&.";
- my $ctrl = ord($1) - 64;
- if($ctrl < 255 || $ctrl < 0)
- {
- doWarn 1, "Unrecognizable control sequence \\$&.";
- next;
- }
- replaceString \$str, sprintf("%03o", $ctrl), 0, 2;
- next;
- }
-
- elsif($char =~ /^[luLUEQ]/)
- {
- # perl special escape sequences.
- # we'll let them keep the slashes.
- replaceString \$str, '\\', 0, 0;
- next;
- }
-
- else
- {
- # in all other cases, the slash needs to be discarded.
- replaceString \$str, '', -1, 1;
- next;
- }
- # end of while loop for slashes.
- }
-
- # return value is the converted string.
- $str;
-}
-
-
-# this one replaces a part of string in the specified position.
-# it also sets the search position to the end of the replaced substring.
-# the arguments are
-# - reference of the target string
-# - replacement text
-# - starting position of the substring replaced (relative to pos)
-# - length of the substring replaced
-sub replaceString($$$$)
-{
- my $str_ref = shift;
- my $replace_str = shift;
- my $del_start = shift;
- my $num_del = shift;
-
- my $p = pos($$str_ref);
- $$str_ref = substr($$str_ref, 0, $p + $del_start) .
- $replace_str .
- substr($$str_ref, $p + $del_start + $num_del);
-
- # adjust the search position.
- pos($$str_ref) = $p + $del_start + length($replace_str);
-}
-
-
-# sends warning to standard error. the first argument is for the
-# warning level:
-# 0: critical - always show
-# 1: warning - show if verbose
-# 2: bug - shouldn't happen
-# the second argument is the message to be displayed.
-sub doWarn($$)
-{
- my $level = shift;
- my $message = shift;
-
- if($level == 0)
- {
- # critical error.
- warn "ERROR: " . $message . "\n";
- }
-
- elsif($level == 1)
- {
- # warning.
- warn "WARNING: " . $message . "\n" if exists($opts{"verbose"});
- }
-
- elsif($level == 2)
- {
- # programming error (of plxgettext).
- warn "BUG: " . $message . "\n";
- }
-
- else
- {
- # shouldn't happen. let's do a recursive call.
- doWarn 2, 'Invalid warning level specified.';
- }
-}
-
-
-# tell user what we are doing.
-sub doNotify($)
-{
- my $msg = shift;
-
- if(!defined($opts{"verbose"}))
- {
- # nothing we can do.
- return;
- }
-
- print $msg . "\n";
-}
-
-
-# show the help message.
-sub displayHelp()
-{
-}
generated by cgit v1.2.1 (git 2.21.0) at 2024-07-05 04:44:12 +0000