added Next version
|
1 |
use strict; |
2 |
use warnings; |
|
3 | ||
4 |
use FindBin; |
|
5 |
use File::Basename qw/basename fileparse/; |
|
6 |
use File::Copy 'copy'; |
|
7 | ||
8 |
my $top = $FindBin::Bin; |
|
9 |
my $common = "$top/common"; |
|
10 |
my $common_uc = "$top/common_uc"; |
|
11 |
mkdir $common_uc unless -d $common_uc; |
|
12 | ||
13 |
my @modules = grep { -f $_ } glob("$common/*"); |
|
14 |
for my $module (@modules) { |
|
15 |
my $module_base = basename $module; |
|
16 |
copy $module, "$common_uc/$module_base" |
|
17 |
or die "Can't move module file: $!"; |
|
18 |
} |
|
19 | ||
20 |
my @dirs = grep { -d $_ } glob("$FindBin::Bin/common/*"); |
|
21 |
for my $dir (@dirs) { |
|
22 |
my $base_dir = basename $dir; |
|
23 |
my $model_dir_uc = "$common_uc/$base_dir"; |
|
24 |
mkdir $model_dir_uc unless -d $model_dir_uc; |
|
25 |
|
|
26 |
my @files = grep { /table\d\.pm/ } glob("$dir/*"); |
|
27 |
for my $file (@files) { |
|
28 |
|
|
29 |
my $content = do { |
|
30 |
open my $fh, '<', $file; |
|
31 |
local $/; |
|
32 |
<$fh>; |
|
33 |
}; |
|
34 |
|
|
35 |
$content =~ s/table(\d)/TABLE$1/g; |
|
36 |
$content =~ s/TABLE2_alias/TABLE2_ALIAS/g; |
|
37 |
$content =~ s/key(\d)/KEY$1/g; |
|
38 |
|
|
39 |
my $base_name = (fileparse($file, qr/\..+$/))[0]; |
|
40 |
$base_name = uc $base_name; |
|
41 |
my $new_file = "$common_uc/$base_dir/$base_name.pm"; |
|
42 |
|
|
43 |
open my $fh, '>', $new_file |
|
44 |
or die "Can't write file: $!"; |
|
45 |
|
|
46 |
print $fh $content; |
|
47 |
} |
|
48 |
} |