File: extractplots

package info (click to toggle)
analitza 4:17.08.3-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 3,824 kB
  • sloc: cpp: 26,899; perl: 63; sh: 16; makefile: 9
file content (90 lines) | stat: -rwxr-xr-x 1,892 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
#!/usr/bin/env perl

# Copyright (c) 2012 Pino Toscano <pino@kde.org>

sub usage
{
  warn <<"EOF";

extractplots [OPTIONS] FILENAMES...

This script extract descriptions from Analitza plots and
writes on standard output (usually redirected to rc.cpp) the equivalent
tr() calls so that xgettext can parse them.

--context=name    : Give tr() calls a context name: tr(text, "name")
--help|?          : Display this summary

EOF

  exit;
}

###########################################################################################

use strict;
use warnings;
use Getopt::Long;

sub escape_to_c($) {
    my $text = shift;

    $text =~ s/\\/\\\\/g; # escape \
    $text =~ s/\"/\\\"/g; # escape "

    return $text;
}

###########################################################################################

GetOptions ("context=s"   => \my $opt_context,       # tr() context
            "help|?"      => \&usage );

unless (@ARGV)
{
  warn "No filename specified";
  exit;
}

###########################################################################################

sub out_message {
    my ($ctxt, $text, @cmnts) = @_;
    for my $cmnt (@cmnts) {
        print qq|// $cmnt\n|;
    }
    if (defined $text) {
        $text = escape_to_c($text);
        if (defined $ctxt) {
            $ctxt = escape_to_c($ctxt);
            print qq|QObject::tr("$text", "$ctxt");\n|;
        } else {
            print qq|QObject::tr("$text");\n|;
        }
    }
}

for my $file_name (@ARGV)
{
  my $fh;

  unless (open $fh, "<", $file_name)
  {
    next;
  }

  while (<$fh>)
  {
    my $string = $_;
    if ($string =~ /.*\/\/ *([^ ]*) *\/\/.*/)
    {
      my @comments = ();

      (my $norm_fname = $file_name) =~ s/^\.\///;
      push @comments, "i18n: file: $norm_fname:$.";
      out_message($opt_context, $1, @comments);
    }
  }

  close $fh or warn "Failed to close: '$file_name': $!";
}