DBIx-Custom / t / create_fullqualified_module.pl /
Newer Older
48 lines | 1.364kb
added create_fullqualified_m...
Yuki Kimoto authored on 2012-03-01
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_fullqualified = "$top/common_fullqualified";
11
mkdir $common_fullqualified unless -d $common_fullqualified;
12

            
13
my @modules = grep { -f $_ } glob("$common/*");
14
for my $module (@modules) {
15
    my $module_base = basename $module;
16
    copy $module, "$common_fullqualified/$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_fullqualified = "$common_fullqualified/$base_dir";
24
    mkdir $model_dir_fullqualified unless -d $model_dir_fullqualified;
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_fullqualified/$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
}