DBIx-Custom / t / create_fullqualified_module.pl /
Newer Older
49 lines | 1.416kb
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';
support model full-qualified...
Yuki Kimoto authored on 2012-03-01
7
use File::Path 'mkpath';
added create_fullqualified_m...
Yuki Kimoto authored on 2012-03-01
8

            
9
my $top = $FindBin::Bin;
10
my $common = "$top/common";
11
my $common_fullqualified = "$top/common_fullqualified";
12
mkdir $common_fullqualified unless -d $common_fullqualified;
13

            
14
my @modules = grep { -f $_ } glob("$common/*");
15
for my $module (@modules) {
16
    my $module_base = basename $module;
17
    copy $module, "$common_fullqualified/$module_base"
18
      or die "Can't move module file: $!";
19
}
20

            
21
my @dirs = grep { -d $_ } glob("$FindBin::Bin/common/*");
22
for my $dir (@dirs) {
23
    my $base_dir = basename $dir;
24
    my $model_dir_fullqualified = "$common_fullqualified/$base_dir";
25
    mkdir $model_dir_fullqualified unless -d $model_dir_fullqualified;
26
    
27
    my @files = grep { /table\d\.pm/ } glob("$dir/*");
28
    for my $file (@files) {
29
    
30
      my $content = do {
31
        open my $fh, '<', $file;
32
        local $/;
33
        <$fh>;
34
      };
support model full-qualified...
Yuki Kimoto authored on 2012-03-01
35

            
36
      $content =~ s/::table(\d)/::main::table$1/g;
37
      $content =~ s/([^:])table(\d)/$1main.table$2/g;
added create_fullqualified_m...
Yuki Kimoto authored on 2012-03-01
38
      
support model full-qualified...
Yuki Kimoto authored on 2012-03-01
39
      mkpath "$common_fullqualified/$base_dir/main";
added create_fullqualified_m...
Yuki Kimoto authored on 2012-03-01
40
      my $base_name = (fileparse($file, qr/\..+$/))[0];
support model full-qualified...
Yuki Kimoto authored on 2012-03-01
41
      $base_name = $base_name;
42
      my $new_file = "$common_fullqualified/$base_dir/main/$base_name.pm";
added create_fullqualified_m...
Yuki Kimoto authored on 2012-03-01
43
      
44
      open my $fh, '>', $new_file
45
        or die "Can't write file: $!";
46
      
47
      print $fh $content;
48
    }
49
}