Warning, /sdk/kde-dev-scripts/extractattr is written in an unsupported language. File is not indexed.

0001 #! /usr/bin/env perl
0002 
0003 #
0004 # Copyright (c) 2004 Richard Evans <rich@ridas.com>
0005 #
0006 # License: LGPL 2.0
0007 #
0008 
0009 sub usage
0010 {
0011   warn <<"EOF";
0012 
0013 extractattr [flags] filenames
0014 
0015 This script extracts element attributes from designer (.ui) and XMLGIU (.rc) files
0016 and writes on standard output (usually redirected to rc.cpp) the equivalent
0017 i18n() calls so that xgettext can parse them.
0018 
0019 --attr=spec    : Specify the attribute to be extracted. The specification
0020                  consists of the following comma separated arguments:
0021 
0022                  Element,attribute[,context]
0023 
0024                  The context is optional and overrides the name set by
0025                  --context below. Repeat the flag to specify multiple
0026                  attributes:
0027 
0028                  --attr=Title,data --attr=Description,data,Stencils
0029 
0030 --context=name : Give i18n calls a context name: i18nc("name", ...)
0031 --lines        : Include source line numbers in comments (deprecated, it is switched on by default now)
0032 --help|?       : Display this summary
0033 
0034 EOF
0035 
0036   exit;
0037 }
0038 
0039 ###########################################################################################
0040 
0041 use strict;
0042 use warnings;
0043 use Getopt::Long;
0044 
0045 ###########################################################################################
0046 # Add options here as necessary - perldoc Getopt::Long for details on GetOptions
0047 
0048 GetOptions ( "attr=s"    => \my @opt_attr,
0049              "context=s" => \my $opt_context,
0050              "lines"     => \my $opt_lines,
0051              "help|?"    => \&usage );
0052 
0053 unless ( @ARGV )
0054 {
0055   warn "No filename specified";
0056   exit;
0057 }
0058 
0059 unless ( @opt_attr )
0060 {
0061   warn "No attributes specified";
0062   exit;
0063 }
0064 
0065 ###########################################################################################
0066 # Program start proper - NB $. is the current line number
0067 
0068 my $code =<<'EOF';
0069 our $file_name;
0070 
0071 for $file_name ( @ARGV )
0072 {
0073   my $fh;
0074 
0075   unless ( open $fh, "<", $file_name )
0076   {
0077     warn "Failed to open: '$file_name': $!";
0078     next;
0079   }
0080 
0081   while ( <$fh> )
0082   {
0083     last if $. == 1 and $_ !~ /^(?:<!DOCTYPE|<\?xml)/;
0084 EOF
0085 
0086 $code .= build_code(@opt_attr) . <<'EOF';
0087   }
0088 
0089   close $fh or warn "Failed to close: '$file_name': $!";
0090 }
0091 
0092 1;
0093 EOF
0094 
0095 # warn "CODE TO EVAL:\n$code\n";
0096   
0097 eval $code or die;
0098 
0099 
0100 sub build_code
0101 {
0102   my $code = "\n";
0103 
0104   my %seen;
0105 
0106   for ( @_ )
0107   {
0108     my ($element, $attribute, $context) = ((split /,/), "", "", "");
0109 
0110     length $element   or die "Missing element in --attr=$_";
0111     length $attribute or die "Missing attribute in --attr=$_";
0112 
0113     if ( $seen{$element . '<' . $attribute}++ )
0114     {
0115       warn "Skipping duplicate flag --attr=$_ (element/attribute pair has already been specified)";
0116       next;
0117     }
0118 
0119     $code .= "    /<" . quotemeta($element)   . qq| [^>]*?| .
0120                         quotemeta($attribute) . qq|="([^"]+)"/ and write_i18n('| . $context . qq|', \$1, "| . $element . "\",\"" . $attribute . qq|");\n|;
0121   }
0122 
0123   return "$code\n";
0124 }
0125 
0126 sub write_i18n
0127 {
0128   my ($context, $text, $tag, $attr) = @_;
0129 
0130   our $file_name;
0131 
0132   unless ( $text )
0133   {
0134     print "// Skipped empty message at $file_name line $.\n";
0135     return;
0136   }
0137 
0138   $text =~ s/&lt;/</g;
0139   $text =~ s/&gt;/>/g;
0140   $text =~ s/&apos;/\'/g;
0141   $text =~ s/&quot;/\"/g;
0142   $text =~ s/&amp;/&/g;
0143 
0144   # Escape characters exactly like uic does it
0145   # (As extractrc needs it, we follow the same rule to avoid to be different.)
0146   $text =~ s/\\/\\\\/g; # escape \
0147   $text =~ s/\"/\\\"/g; # escape "
0148   $text =~ s/\r//g; # remove CR (Carriage Return)
0149   $text =~ s/\n/\\n\"\n\"/g; # escape LF (Line Feed). uic also change the code line at a LF, we do not do that.
0150   
0151   $context ||= $opt_context;
0152 
0153   (my $norm_fname = $file_name) =~ s/^\.\///;
0154   print "//i18n: tag $tag attribute $attr\n";
0155   print "//i18n: file: $norm_fname:$.\n";
0156   if ( $context )
0157   {
0158     print qq|i18nc("$context","$text");\n|;
0159   }
0160   else
0161   {
0162     print  qq|i18n("$text");\n|;
0163   }
0164 }
0165