File: foomatic-replaceoldprinterids.in

package info (click to toggle)
foomatic-db-engine 4.0.4-3
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 1,752 kB
  • ctags: 490
  • sloc: perl: 12,029; ansic: 6,848; python: 1,139; sh: 263; makefile: 244; xml: 83
file content (93 lines) | stat: -rw-r--r-- 2,599 bytes parent folder | download | duplicates (10)
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
91
92
93
#!@PERL@

# This is foomatic-nonumericalids, it renames all printer entries with a
# numerical ID and generates a translation table.

use Foomatic::Defaults;
use Foomatic::DB;

# Read out the program name with which we were called, but discard the path
$0 =~ m!/([^/]+)\s*$!;
$progname = $1;

use Getopt::Std;
getopts("r:l:t:h");
if ($opt_h) {
    print "
foomatic-replaceoldprinterids [ -l <leftpattern> ] [ -r <rightpattern> ] \
                              [ -t <transltable> ] file1 [ file2 ... ]
 -l <leftpattern>:  Regular expresasion (Perl) which has to be matched 
                    at the left side of the old printer ID (default:
                    \"recnum=\")
 -r <rightpattern>: Regular expresasion (Perl) which has to be matched 
                    at the right side of the old printer ID (default:
                    \"(?!\\d)\", this pattern means that on the right
                    side should be no further digit, see \"man perlre\")
 -t <transltable>:  Translation table, every line an old ID, white space,
                    a new ID (default $libdir/db/oldprinterids)
 file1, file2, ...  File(s) to be processed

";
    exit 0;
}

my $leftpattern = 'recnum=';
my $rightpattern = '(?!\d)';
$leftpattern = $opt_l if defined($opt_l);
$rightpattern = $opt_r if defined($opt_r);
my %idhash;
my $idtable = "$libdir/db/oldprinterids";
$idtable = $opt_t if $opt_t;
open IDTABLE, "< $idtable" ||
    die "File $idtable cannot be read!\n";
while (<IDTABLE>) {
    if (/^\s*(\S+)\s+(\S+)\s*$/) {
	$idhash{$1} = $2;
    }
}
close IDTABLE;

my $changes = 0;
my $chfiles = 0;
my @chfilelist;
while (my $file = shift @ARGV) {
    print "Processing $file";
    open FILE, "< $file" ||
	die "File $file cannot be read!\n";
    my @lines = <FILE>;
    close FILE;
    my $ch = 0;
    for my $id (keys %idhash) {
	foreach (@lines) {
	    if (s!($leftpattern)$id($rightpattern)!$1$idhash{$id}$2!g) {
		$ch = 1;
		$changes ++;
		print ".";
	    }
	}
    }
    print "\n";
    next if !$ch;
    open FILE, "> $file" ||
	die "File $file cannot be written!\n";
    print FILE join('', @lines);
    close FILE;
    print "   Wrote $file.\n";
    $chfiles ++;
    push(@chfilelist, "$file\n");
}

# List of files changed
$file = "modifiedfiles";
open FILE, "> $file" ||
    die "File $file cannot be written!\n";
print FILE join('', @oldidlist, @chfilelist);
close FILE;
print "   Wrote $file.\n";

print "$changes changes on $chfiles files applied.\n";

exit 0;

# member( $a, @b ) returns 1 if $a is in @b, 0 otherwise.
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 };