| … | |
… | |
| 2 | |
2 | |
| 3 | # miscellaneous commands |
3 | # miscellaneous commands |
| 4 | |
4 | |
| 5 | sub rename_to($$$) { |
5 | sub rename_to($$$) { |
| 6 | my ($ob, $from, $to) = @_; |
6 | my ($ob, $from, $to) = @_; |
|
|
7 | |
|
|
8 | warn "<$ob|$from|$to>\n";#d# |
| 7 | |
9 | |
| 8 | $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/ |
10 | $to =~ /^[a-zA-Z0-9.,=#\/%$!^]*$/ |
| 9 | or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things."); |
11 | or return $ob->message ("rename: name must consist only of letters, digits, spaces and a few other things."); |
| 10 | |
12 | |
| 11 | 127 >= length $to |
13 | 127 >= length $to |
| … | |
… | |
| 37 | } |
39 | } |
| 38 | |
40 | |
| 39 | cf::register_command rename => 0, sub { |
41 | cf::register_command rename => 0, sub { |
| 40 | my ($ob, $arg) = @_; |
42 | my ($ob, $arg) = @_; |
| 41 | |
43 | |
| 42 | # support compatibility syntax as well as new syntax |
44 | warn "<<<$arg>>>\n";#d# |
|
|
45 | |
| 43 | if ($arg =~ /^\s* (?: <([^>]+)> \s+) to \s+ <([^>]+)> \s*$/x) { |
46 | if ($arg =~ /^\s* (?: <([^>]+)> \s+)? to \s+ <([^>]+)> \s*$/x) { |
|
|
47 | # compatibility syntax |
| 44 | rename_to $ob, $1, $2; |
48 | rename_to $ob, $1, $2; |
| 45 | } elsif ($arg =~ / |
49 | } elsif ($arg =~ / |
| 46 | ^\s* |
50 | ^\s* |
| 47 | (?: |
51 | (?: |
| 48 | (?: "((?:[^"]+|\\.)*)" | (\S+) ) |
52 | (?: "((?:[^"]+|\\.)*)" | (\S+) ) |
