"Fossies" - the Fresh Open Source Software Archive

Member "foomatic-db-engine-4.0-20221101/foomatic-nonumericalids.in" (1 Nov 2022, 4490 Bytes) of package /linux/misc/foomatic-db-engine-4.0-20221101.tar.gz:


As a special service "Fossies" has tried to format the requested text file into HTML format (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file.

    1 #!@PERL@
    2 
    3 # This is foomatic-nonumericalids, it renames all printer entries with a
    4 # numerical ID and generates a translation table.
    5 
    6 use Foomatic::Defaults;
    7 use Foomatic::DB qw/get_overview/;
    8 # Needs "get_overview" to be added to the "@EXPORT_OK" list of DB.pm!
    9 
   10 # Read out the program name with which we were called, but discard the path
   11 $0 =~ m!/([^/]+)\s*$!;
   12 $progname = $1;
   13 
   14 my $db = new Foomatic::DB;
   15 
   16 # Get the printer overview list as a Perl data structure
   17 $db->get_overview();
   18 
   19 # Find all numerical IDs, determine new clear-text IDs, and rename the
   20 # printer entry files.
   21 my @oldidlist;
   22 my @newidlist;
   23 my @translationtable;
   24 my %idhash;
   25 
   26 my $printer;
   27 for $printer (@{$db->{'overview'}}) {
   28     # Nothing to do if ID is not numerical
   29     next if $printer->{'id'} !~ /^\d/;
   30     # Generate new ID from make and model name
   31     $newid = join('-',($printer->{'make'},
   32 		       $printer->{'model'}));
   33     $newid =~ s![ /,\(\)\?]!_!g;
   34     $newid =~ s![\+]!plus!g;
   35     $newid =~ s![\&]!_and_!g;
   36     $newid =~ s!__+!_!g;
   37     $newid =~ s!_$!!;
   38     $newid =~ s!_-!-!;
   39     $newid =~ s!^_!!;
   40     # Append a number in case of duplicate IDs
   41     if (member($newid, @newidlist)) {
   42 	print "WARNING: ID \"$newid\" already exists, ";
   43 	$newid .= '_';
   44 	my $i = 1;
   45 	while (member("$newid$i", @newidlist)) {
   46 	    $i ++;
   47 	}
   48 	$newid .= $i;
   49 	print "using \"$newid\",\n";
   50     }
   51     print "$printer->{'make'} $printer->{'model'}: $printer->{'id'} -> $newid\n";
   52     # Add change to lists
   53     push (@oldidlist, "db/source/printer/$printer->{'id'}.xml\n");
   54     push (@newidlist, "db/source/printer/$newid.xml\n");
   55     push (@translationtable, "$printer->{'id'} $newid\n");
   56     $idhash{$printer->{'id'}} = $newid;
   57     # Rename the printer entry file
   58     system("mv $libdir/db/source/printer/$printer->{'id'}.xml $libdir/db/source/printer/$newid.xml") and
   59 	die "Could not rename $printer->{'id'}.xml to $newid.xml.\n";
   60     print "   Renamed $printer->{'id'}.xml to $newid.xml.\n";
   61 }
   62 
   63 # Translation table to convert old numerical printer IDs to new
   64 # clear-text ones
   65 my $file = "$libdir/db/oldprinterids";
   66 open FILE, "> $file" ||
   67     die "File $file cannot be written!\n";
   68 print FILE join('', @translationtable);
   69 close FILE;
   70 print "   Wrote $file.\n";
   71 
   72 # List of old printer files to be removed from CVS
   73 $file = "oldprinterfiles";
   74 open FILE, "> $file" ||
   75     die "File $file cannot be written!\n";
   76 print FILE join('', @oldidlist);
   77 close FILE;
   78 print "   Wrote $file.\n";
   79 
   80 # List of files to be added to the CVS
   81 $file = "newprinterfiles";
   82 open FILE, "> $file" ||
   83     die "File $file cannot be written!\n";
   84 print FILE join('', @newidlist);
   85 close FILE;
   86 print "   Wrote $file.\n";
   87 
   88 # Scan through all files of the database and replace all references to
   89 # numerical printer IDs to the appriopriate new IDs
   90 my @xmlfiles;
   91 opendir DIR, "$libdir/db/source/printer" ||
   92     die "Cannot open printer XML directory!\n";
   93 while ($file = readdir(DIR)) {
   94     push(@xmlfiles, "printer/$file") if $file =~ /^[^\.].*\.xml$/;
   95 }
   96 closedir DIR;
   97 opendir DIR, "$libdir/db/source/driver" ||
   98     die "Cannot open driver XML directory!\n";
   99 while ($file = readdir(DIR)) {
  100     push(@xmlfiles, "driver/$file") if $file =~ /^[^\.].*\.xml$/;
  101 }
  102 closedir DIR;
  103 opendir DIR, "$libdir/db/source/opt" ||
  104     die "Cannot open option XML directory!\n";
  105 while ($file = readdir(DIR)) {
  106     push(@xmlfiles, "opt/$file") if $file =~ /^[^\.].*\.xml$/;
  107 }
  108 closedir DIR;
  109 
  110 my $changes = 0;
  111 my $chfiles = 0;
  112 my @chfilelist;
  113 for $file (@xmlfiles) {
  114     print "Processing $file";
  115     open FILE, "< $libdir/db/source/$file" ||
  116 	die "Database entry $file cannot be read!\n";
  117     my @lines = <FILE>;
  118     close FILE;
  119     my $ch = 0;
  120     for my $id (keys %idhash) {
  121 	foreach (@lines) {
  122 	    if (s!(printer/|recnum=)$id($|\D)!$1$idhash{$id}$2!g) {
  123 		$ch = 1;
  124 		$changes ++;
  125 		print ".";
  126 	    }
  127 	}
  128     }
  129     print "\n";
  130     next if !$ch;
  131     open FILE, "> $libdir/db/source/$file" ||
  132 	die "Database entry $file cannot be written!\n";
  133     print FILE join('', @lines);
  134     close FILE;
  135     print "   Wrote $file.\n";
  136     $chfiles ++;
  137     push(@chfilelist, "db/source/$file\n");
  138 }
  139 
  140 # List of files changed in CVS
  141 $file = "changedfiles";
  142 open FILE, "> $file" ||
  143     die "File $file cannot be written!\n";
  144 print FILE join('', @oldidlist, @chfilelist);
  145 close FILE;
  146 print "   Wrote $file.\n";
  147 
  148 print "$changes changes on $chfiles files applied.\n";
  149 
  150 exit 0;
  151 
  152 # member( $a, @b ) returns 1 if $a is in @b, 0 otherwise.
  153 sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 };