File indexing completed on 2024-03-24 05:44:49

0001 #!/usr/bin/perl -w
0002 # fixuifiles processes .ui files and removes some insanity:
0003 # * Too high minimum Qt version (see $minversion_* in the top of the script)
0004 # * Hardcoded untranslatable Alt+Letter accels (auto-added by Qt Designer)
0005 # * Captions that are equal to classname (auto-added by Qt Designer)
0006 
0007 # This script is licensed under the GPL version 2.
0008 # (c) 2004 David Faure <faure@kde.org>
0009 # Based on fixkdeincludes, (c) 2001-2003 Dirk Mueller <mueller@kde.org>
0010 
0011 use strict;
0012 use File::Basename;
0013 use Cwd;
0014 
0015 # Fix the version number in .ui files if it's bigger than this:
0016 my $default_minversion_maj = 4;
0017 my $default_minversion_min = 0;
0018 
0019 # Known words which are ok as captions
0020 my %knowncaptions = (
0021   'Settings' => '',
0022   'Statistics' => '',
0023   'General' => '',
0024   'Tracks' => '',
0025   'Constants' => '',
0026   'Preferences' => '',
0027   'Encryption' => ''
0028 );
0029 
0030 # declaration of useful subroutines
0031 sub process_ui_file($);
0032 sub find_ui_files($);
0033 sub read_required_version($);
0034 
0035 # some global variables
0036 my $verbose = 0; # turns on debugging
0037 my $omit_Qt_check = 0; # turns off Qt version checking
0038 my @explicitfiles = (); # filled in if passing files on the command line
0039 my $minversion_maj = $default_minversion_maj;
0040 my $minversion_min = $default_minversion_min;
0041 
0042 while (defined ($ARGV[0]))
0043 {
0044   $_ = shift;
0045   if (/^--help$|^-h$/)  {
0046     print "Usage: fixuifiles [OPTIONS] files...\n";
0047     print "Options are:\n";
0048     print "\t-v, --verbose\tBe verbose\n";
0049     print "\t--omitqtcheck\tDoes not check for Qt minimum version\n";
0050     exit 0;
0051   }
0052   elsif (/^--verbose$|^-v$/) {
0053     $verbose = 1;
0054   }elsif (/^--omitqtcheck/) {
0055     $omit_Qt_check = 1;
0056   }
0057   elsif (!/^-/) {
0058     push @explicitfiles, $_;
0059   }
0060 }
0061 
0062 # Find .ui files in the given dir
0063 sub find_ui_files($)
0064 {
0065   my ( $dir ) = @_;
0066 
0067   opendir (DIR, "$dir") || die "Couldn't read '$dir'\n";
0068   my @files = grep { /^.*\.ui$/ } readdir(DIR);
0069   closedir(DIR);
0070 
0071   #print "found files: [ " . join(' ', @files) . " ] in $dir\n" if ($verbose);
0072 
0073   # prefix them with $dir
0074   my @retfiles = ();
0075   foreach my $file(@files) {
0076     push @retfiles, "$dir/$file";
0077   }
0078 
0079   return @retfiles;
0080 }
0081 
0082 # Ensure the version at the top of the file is not too high
0083 sub fix_version($)
0084 {
0085   my $srcfile = shift @_;
0086   open(SRC, "< $srcfile") || die "fix_version: couldn't open '$srcfile'\n";
0087   my @contents = <SRC>;
0088   my @fixedcontents = ();
0089   close(SRC);
0090   my $needfix = 0;
0091   my $foundversion = 0;
0092   foreach my $line (@contents) {
0093       if (!$foundversion && $line =~ m/version=\"([0-9]+)\.([0-9]+)(\.[0-9]+)?\"/) {
0094       my $version_maj = $1;
0095       my $version_min = $2;
0096       if ( $version_maj > $minversion_maj ||
0097            ( $version_maj == $minversion_maj && $version_min > $minversion_min ) ) {
0098           $line =~ s/version=\"[0-9]+\.[0-9]+\"/version=\"$minversion_maj.$minversion_min\"/o;
0099           $needfix = 1;
0100           print "$srcfile: version was $version_maj.$version_min, set to $minversion_maj.$minversion_min\n";
0101       }
0102       $foundversion = 1;
0103       }
0104       push @fixedcontents, $line;
0105   }
0106   if (!$foundversion) {
0107       # TODO improve so that the script adds the necessary line
0108       print "$srcfile has no UI version, please fix it\n";
0109   }
0110   if ($needfix) {
0111       open(SRC, "> $srcfile") || die "fix_version: couldn't open '$srcfile' for writing\n";
0112       print SRC @fixedcontents;
0113       close(SRC);
0114   }
0115 }
0116 
0117 # Ensure no auto-added Alt+letter accel exists - those are untranslatable
0118 sub fix_accels($)
0119 {
0120   my $srcfile = shift @_;
0121   open(SRC, "< $srcfile") || die "fix_accels: couldn't open '$srcfile'\n";
0122   my @contents = <SRC>;
0123   close(SRC);
0124   return if ( !grep( /<string>Alt\+[A-Z]<\/string>/, @contents ));
0125   my @fixedcontents = ();
0126 
0127   my $firstline;
0128   my $accelsremoved = 0;
0129   my $inside_accel = 0;
0130   # inside_accel is 0 before <property>
0131   # 1 after <property> and before <string>
0132   # 2 after <string> if alt+letter, and before </property>
0133   foreach my $line (@contents) {
0134       if ( $inside_accel == 1 ) {
0135       if ( $line =~ m/<string>(Alt\+[A-Z])<\/string>/ ) {
0136           print "$srcfile: accel $1 removed\n" if ($verbose);
0137           $inside_accel = 2;
0138           $accelsremoved++;
0139       } else { # Not alt+letter, keep accel
0140           push @fixedcontents, $firstline;
0141           $inside_accel = 0;
0142       }
0143       }
0144       if ($line =~ m/property name=\"shortcut\"/) {
0145       $inside_accel = 1;
0146       $firstline = $line;
0147       }
0148       if ($inside_accel == 0) {
0149       push @fixedcontents, $line;
0150       }
0151       $inside_accel = 0 if ($inside_accel && $line =~ m/<\/property>/);
0152   }
0153   if ($accelsremoved) {
0154       print "$srcfile: $accelsremoved shortcut removed\n";
0155       open(SRC, "> $srcfile") || die "fix_accels: couldn't open '$srcfile' for writing\n";
0156       print SRC @fixedcontents;
0157       close(SRC);
0158   }
0159 }
0160 
0161 # Ensure no auto-added caption exists - it's pretty stupid to have to
0162 # translate Form1 or MyClassName
0163 sub fix_captions($)
0164 {
0165   my $srcfile = shift @_;
0166   open(SRC, "< $srcfile") || die "fix_captions: couldn't open '$srcfile'\n";
0167   my @contents = <SRC>;
0168   close(SRC);
0169   my @fixedcontents = ();
0170 
0171   my $firstline;
0172   my $class = "";
0173   my $captionsremoved = 0;
0174   my $inside_caption = 0;
0175   # inside_caption is 0 before <property>
0176   # 1 after <property> and before <string>
0177   # 2 after <string> if caption should be removed, and before </property>
0178   foreach my $line (@contents) {
0179       $class = $1 if ($line =~ m/<class>(.*)<\/class>/);
0180       if ( $inside_caption == 1 ) {
0181       $line =~ m/<string.*\>(.*)<\/string>/ || die "Malformed XML (no string under caption/windowTitle) in file $srcfile";
0182       my $caption = $1;
0183       print "$srcfile: caption='$caption' class='$class'\n" if ($verbose);
0184       if ( ( $caption eq $class && !defined $knowncaptions{$caption} ) ||
0185          ($caption =~ m/Form[0-9]*/) || ($caption =~ m/Frame[0-9]*/) ) {
0186           if ( $caption =~ m/^[A-Z][a-z]*$/ ) {
0187           print "$srcfile: removing caption '$caption' (warning! could be real caption)\n";
0188           } else {
0189           print "$srcfile: removing caption '$caption'\n";
0190           }
0191           $inside_caption = 2;
0192           $captionsremoved++;
0193       } else {                # Real caption, keep it
0194           print "$srcfile: keeping caption '$caption'\n" if ($verbose);
0195           push @fixedcontents, $firstline;
0196           $inside_caption = 0;
0197       }
0198       }
0199       if ($line =~ m/property name=\"windowTitle\"/) {
0200       $inside_caption = 1;
0201       $firstline = $line;
0202       }
0203       if ($inside_caption == 0) {
0204       push @fixedcontents, $line;
0205       }
0206       $inside_caption = 0 if ($inside_caption && $line =~ m/<\/property>/);
0207   }
0208   if ($captionsremoved) {
0209       open(SRC, "> $srcfile") || die "fix_captions: couldn't open '$srcfile' for writing\n";
0210       print SRC @fixedcontents;
0211       close(SRC);
0212   }
0213 }
0214 
0215 # Find a .qt_minversion in $dir or any parent directory.
0216 sub read_required_version($)
0217 {
0218   my $dir = Cwd::abs_path( shift @_ );
0219 
0220   $minversion_maj = $default_minversion_maj;
0221   $minversion_min = $default_minversion_min;
0222   while ( length($dir) > 1 ) {
0223       my $versfile = "$dir/.qt_minversion";
0224       my $version;
0225       if ( open (VERSFILE, "< $versfile") ) {
0226       while (<VERSFILE>) {
0227           $version = $_ if (!/^#/);
0228       }
0229       close(VERSFILE);
0230       } 
0231       if (defined $version && $version =~ m/([0-9]+)\.([0-9]+)/) {
0232       $minversion_maj = $1;
0233       $minversion_min = $2;
0234       print "Found min version $1.$2 in $versfile\n" if ($verbose);
0235       return;
0236       }
0237       $dir = dirname($dir);
0238   }
0239 }
0240 
0241 # Process one .ui file
0242 sub process_ui_file($)
0243 {
0244   my $file = shift @_;
0245   &read_required_version( dirname($file) );
0246 
0247   print "Checking: $file\n" if($verbose);
0248   &fix_version($file) if(!$omit_Qt_check);
0249   &fix_accels($file);
0250   &fix_captions($file);
0251 }
0252 
0253 #############################################################################
0254 # here is the main logic
0255 #
0256 
0257 # process files from the command line, if any
0258 if ( $#explicitfiles >= 0 ) {
0259   foreach my $file( @explicitfiles ) {
0260     &process_ui_file( $file );
0261   }
0262   exit 0;
0263 }
0264 
0265 # first generate a list of subdirectories
0266 my @dirlist = ();
0267 push @dirlist, ".";
0268 foreach my $dir ( @dirlist ) {
0269  opendir (DIR, "$dir") || warn "Couldn't read '$dir'";
0270  my $subdir = "";
0271  while( $subdir = readdir(DIR)) {
0272    next if ($subdir =~ /^\./);
0273    next if !( -d "$dir/$subdir");
0274    push @dirlist, "$dir/$subdir";
0275  }
0276  closedir(DIR);
0277 }
0278 
0279 # now iterate over all subdirs
0280 foreach my $dir(@dirlist) {
0281   my @uifile = find_ui_files($dir);
0282   foreach my $file(@uifile) {
0283     &process_ui_file($file);
0284   }
0285 }