- Improved some comments (some taken from the new cull-options output).
[rsync/rsync.git] / support / cull_options
CommitLineData
782d1091
WD
1#!/usr/bin/perl
2# This script outputs some perl code that parses all possible options
3# that the code in options.c might send to the server. This perl code
4# is included in the rrsync script.
5use strict;
6no strict 'refs';
7
8our(%short_no_arg, %short_with_num);
9our(%long_no_arg, %long_before_arg, %long_with_arg);
10our $last_long_opt;
11
12open(IN, '../options.c') or die "Unable to open ../options.c: $!\n";
13
14while (<IN>) {
15 if (/\Qargstr[x++]\E = '(.)'/) {
16 $short_no_arg{$1} = 1;
17 undef $last_long_opt;
18 } elsif (/\Qasprintf(\E[^,]+, "-([a-zA-Z0-9])\%l?[ud]"/) {
19 $short_with_num{$1} = 1;
20 undef $last_long_opt;
21 } elsif (/\Qargs[ac++]\E = "--([^"=]+)"/) {
22 $last_long_opt = $1;
23 $long_no_arg{$1} = 1;
24 } elsif (defined($last_long_opt)
25 && /\Qargs[ac++]\E = ([^["\s]+);/ && $1 ne 'dest_option') {
26 delete $long_no_arg{$last_long_opt};
27 $long_before_arg{$last_long_opt} = 1;
28 undef $last_long_opt;
29 } elsif (/dest_option = "--([^"])"/) {
30 $long_before_arg{$1} = 1;
31 undef $last_long_opt;
32 } elsif (/\Qasprintf(\E[^,]+, "--([^"=]+)=/ || /\Qargs[ac++]\E = "--([^"=]+)=/) {
33 $long_with_arg{$1} = 1;
34 undef $last_long_opt;
35 }
36}
37close IN;
38
ef1233cb
WD
39my $short_no_arg = join('', sort keys %short_no_arg);
40my $short_with_num = join('', sort keys %short_with_num);
41
42print <<EOT;
43
44# These options are the only options that rsync might send to the server,
45# and only in the option/arg format that the stock rsync produces.
555bc0e3 46
ef1233cb
WD
47# To disable a short-named option, add its letter to this string:
48our \$short_disabled = '';
555bc0e3
WD
49
50our \$short_no_arg = '$short_no_arg'; # DO NOT REMOVE ANY
51our \$short_with_num = '$short_with_num'; # DO NOT REMOVE ANY
52
ef1233cb
WD
53# To disable a long-named option, change its value to a 0 (NOTE: at least
54# one option appears in two places!). A value of -1 means the arg doesn't
55# need checking, a 1 means to check it, a 2 means only check when receiving.
56EOT
782d1091
WD
57
58foreach my $name (qw( long_no_arg long_with_arg long_before_arg )) {
59 $_ = "our \%$name = (\n '" . join("' => 1,\n '", sort keys %$name) . "' => 1,\n);\n";
60 if ($name eq 'long_before_arg') {
61 s/ 1,/ 2,/g;
62 s/('files-from' =>) 2,/$1 1,/;
63 s/('max-.* =>) 2,/$1 -1,/g;
64 } else {
65 s/ 1,/ -1,/g;
66 s/('files-from' =>) -1,/$1 1,/;
67 }
68 s/('remove-.* =>) (-?\d),/$1 \$ro ? 0 : $2,/g;
69 print;
70}
b3181708
WD
71
72print "\n";