diff options
author | Zeus Panchenko <zeus@camb.us> | 2010-10-15 14:44:29 +0000 |
---|---|---|
committer | Zeus Panchenko <zeus@camb.us> | 2010-10-15 14:44:29 +0000 |
commit | dadfcb9f00e2a6a5ad8a1a5cd2fa42ea7da1d525 (patch) | |
tree | 7be9215a32411ea059a7fc67f985b5dac5844ba9 | |
parent | 9af0752f9971767f69d57ef822dc007de10fc15f (diff) | |
download | renrot-dadfcb9f00e2a6a5ad8a1a5cd2fa42ea7da1d525.tar.gz renrot-dadfcb9f00e2a6a5ad8a1a5cd2fa42ea7da1d525.tar.bz2 |
initial tree injectgit-renrot_rfile
git-svn-id: file:///svnroot/renrot/branches/renrot_rfile@594 fe2816f4-e837-0410-b10a-f608c9d244a1
-rwxr-xr-x | modules/renrot_dir.pm | 47 | ||||
-rwxr-xr-x | modules/renrot_msg.pm | 86 | ||||
-rwxr-xr-x | rfile | 83 |
3 files changed, 216 insertions, 0 deletions
diff --git a/modules/renrot_dir.pm b/modules/renrot_dir.pm new file mode 100755 index 0000000..701b9c4 --- /dev/null +++ b/modules/renrot_dir.pm | |||
@@ -0,0 +1,47 @@ | |||
1 | use strict; | ||
2 | |||
3 | package renrot_dir; | ||
4 | |||
5 | ################################################### | ||
6 | # Usage : $a = new renrot_dir; | ||
7 | # Purpose : allocator and initializer | ||
8 | # Returns : initialized class | ||
9 | # Parameters : none | ||
10 | # Throws : no exceptions | ||
11 | # Comments : none | ||
12 | # See Also : n/a | ||
13 | sub new { | ||
14 | my ($pkg, $dir, $ext) = @_; | ||
15 | my @files = (); | ||
16 | return (bless {dir => $dir, | ||
17 | ext => $ext, | ||
18 | files => \@files}, $pkg); | ||
19 | } | ||
20 | |||
21 | ################################################### | ||
22 | # Usage : none | ||
23 | # Purpose : destructor | ||
24 | # Returns : none | ||
25 | # Parameters : none | ||
26 | # Throws : no exceptions | ||
27 | # Comments : none | ||
28 | # See Also : n/a | ||
29 | sub DESTROY { | ||
30 | my $obj = shift; | ||
31 | #print "\$obj->{", $obj->{dir}, "} has been destroied.\n"; | ||
32 | } | ||
33 | |||
34 | ################################################### | ||
35 | # Usage : $obj->filename($base, $ext) | ||
36 | # Purpose : full file name compilator: base . ext = baseext | ||
37 | # Returns : ful filename | ||
38 | # Parameters : 1. basename; 2. extention of ".ext" format | ||
39 | # Throws : no exceptions | ||
40 | # Comments : none | ||
41 | # See Also : n/a | ||
42 | sub file_name { | ||
43 | my ($obj, $base, $ext) = @_; | ||
44 | return $obj->{filename} = $base . $ext; | ||
45 | } | ||
46 | |||
47 | 1; | ||
diff --git a/modules/renrot_msg.pm b/modules/renrot_msg.pm new file mode 100755 index 0000000..2b16f88 --- /dev/null +++ b/modules/renrot_msg.pm | |||
@@ -0,0 +1,86 @@ | |||
1 | use strict; | ||
2 | |||
3 | use Term::ANSIColor; | ||
4 | |||
5 | package msg; | ||
6 | |||
7 | sub new { | ||
8 | my $obj = shift; | ||
9 | my $use_color = shift; | ||
10 | my $quiet = shift; | ||
11 | my $verbose = shift; | ||
12 | my %colors = ( | ||
13 | debug => {value => 'green'}, | ||
14 | error => {value => 'magenta'}, | ||
15 | fatal => {value => 'red'}, | ||
16 | info => {value => 'bold'}, | ||
17 | process => {value => 'white'}, | ||
18 | warning => {value => 'cyan'}, | ||
19 | ); | ||
20 | return (bless {use_color => $use_color, | ||
21 | quiet => $quiet, | ||
22 | verbose => $verbose, | ||
23 | colors => \%colors, | ||
24 | }, $obj); | ||
25 | #$obj->Dbg(4,"msg class has been created.\n"); | ||
26 | } | ||
27 | # destructor | ||
28 | sub DESTROY { | ||
29 | my $obj = shift; | ||
30 | #$obj->Dbg(4,"msg class has been destroied.\n"); | ||
31 | } | ||
32 | # Prints colored message to STDERR | ||
33 | sub coloredprn { | ||
34 | my $obj = shift; | ||
35 | my $facility = shift; | ||
36 | if ($obj->{use_color} != 0) { | ||
37 | if (defined $facility and defined $obj->{colors}{$facility}) { | ||
38 | print STDERR Term::ANSIColor::colored [$obj->{colors}{$facility}{value}], @_; | ||
39 | return; | ||
40 | } | ||
41 | } | ||
42 | print STDERR @_; # fallback to normal print | ||
43 | } | ||
44 | # processing message | ||
45 | sub Proc { | ||
46 | my $obj = shift; | ||
47 | return if ($obj->{quiet} != 0); | ||
48 | |||
49 | if ($obj->{use_color} != 0) { | ||
50 | if (defined $obj->{colors}{'process'}) { | ||
51 | print Term::ANSIColor::colored [$obj->{colors}{'process'}{value}], @_; | ||
52 | return; | ||
53 | } | ||
54 | } | ||
55 | print @_; # fallback to normal print | ||
56 | } | ||
57 | # information message | ||
58 | sub Info { | ||
59 | my $obj = shift; | ||
60 | $obj->coloredprn('info', @_); | ||
61 | } | ||
62 | # warning message | ||
63 | sub Warn { | ||
64 | my $obj = shift; | ||
65 | $obj->coloredprn('warning', "Warning: ", @_); | ||
66 | } | ||
67 | # error message | ||
68 | sub Err { | ||
69 | my $obj = shift; | ||
70 | $obj->coloredprn('error', "ERROR: ", @_); | ||
71 | } | ||
72 | # fatal message | ||
73 | sub Fatal { | ||
74 | my $obj = shift; | ||
75 | $obj->coloredprn('fatal', "FATAL: ", @_); | ||
76 | } | ||
77 | # debug message | ||
78 | sub Dbg { | ||
79 | my $obj = shift; | ||
80 | my $level = shift; | ||
81 | if ($obj->{verbose} >= $level) { | ||
82 | $obj->coloredprn('debug', "DEBUG[$level]: ", @_); | ||
83 | } | ||
84 | } | ||
85 | |||
86 | 1; | ||
@@ -0,0 +1,83 @@ | |||
1 | #!/usr/local/bin/perl | ||
2 | |||
3 | use strict; | ||
4 | use warnings; | ||
5 | use diagnostics; | ||
6 | |||
7 | use Getopt::Long; | ||
8 | |||
9 | my @dir = (); | ||
10 | my $ext = q{}; | ||
11 | my $verbose = 3; | ||
12 | my %cfgOpts = ('use color' => 1); | ||
13 | my $quiet = 0; | ||
14 | |||
15 | my $get_opt = GetOptions ( | ||
16 | "dir|d=s" => \@dir, | ||
17 | "ext|e=s" => \$ext, | ||
18 | "v+" => \$verbose, | ||
19 | ); | ||
20 | |||
21 | require "modules/renrot_dir.pm"; | ||
22 | require "modules/renrot_msg.pm"; | ||
23 | |||
24 | my $msg = new msg($cfgOpts{'use color'},$quiet,$verbose); | ||
25 | |||
26 | if (not $ext) { | ||
27 | $msg->Fatal("You have define EXT!\n"); | ||
28 | exit 1; | ||
29 | } elsif ($ext !~ m/^\..*$/) { | ||
30 | $msg->Dbg(4, "ext:\t",$ext,"\n"); | ||
31 | $ext = "." . $ext; | ||
32 | } | ||
33 | |||
34 | if (not @dir) { | ||
35 | @dir = ("."); | ||
36 | } | ||
37 | |||
38 | use File::Find; | ||
39 | use File::Basename; | ||
40 | |||
41 | my %dir_st = (); | ||
42 | |||
43 | ###################################################################### | ||
44 | # Usage : pars_files | ||
45 | # Purpose : to prepare hash of objects with file details | ||
46 | # Returns : none | ||
47 | # Parameters : none | ||
48 | # Throws : no exceptions | ||
49 | # Comments : it use global variables to fill | ||
50 | # See Also : package renrot_dir | ||
51 | sub pars_files { | ||
52 | my $EXT = (fileparse($File::Find::name, $ext))[2]; | ||
53 | if ( -f $File::Find::name and $EXT eq $ext) { | ||
54 | if (not $dir_st{$File::Find::dir}) { | ||
55 | $dir_st{$File::Find::dir} = new renrot_dir(); | ||
56 | $dir_st{$File::Find::dir}->{dir} = $File::Find::dir; | ||
57 | $dir_st{$File::Find::dir}->{ext} = $EXT; | ||
58 | } | ||
59 | push @{$dir_st{$File::Find::dir}->{files}}, basename($_,$EXT); | ||
60 | } | ||
61 | } | ||
62 | |||
63 | find \&pars_files, @dir; | ||
64 | |||
65 | my @files = (); | ||
66 | foreach my $dir (sort keys %dir_st) { | ||
67 | $msg->Proc("\nDIR: ", $dir, "\n"); | ||
68 | for (my $i = 0,@files = @{$dir_st{$dir}->{files}}; $i < scalar @files; $i++) { | ||
69 | $msg->Proc("\tFILE: ", $files[$i], "\t\tEXT: ", | ||
70 | $dir_st{$dir}->{ext}, "\t FULLNAME: ", | ||
71 | $dir_st{$dir}->file_name($files[$i],$dir_st{$dir}->{ext}),"\n"); | ||
72 | #if ( $i == 0 ) { | ||
73 | # chdir $dir_st{$dir}->{dir}; | ||
74 | #} | ||
75 | #open(FH, $dir_st{$dir}->file_name($files[$i],$dir_st{$dir}->{ext})) | ||
76 | # or die "Can't open ",$dir_st{$dir}->file_name($files[$i],$dir_st{$dir}->{ext}),": $!"; | ||
77 | #while (<FH>) { | ||
78 | # $msg->Proc( $_,"\n"); | ||
79 | #} | ||
80 | #close(FH); | ||
81 | } | ||
82 | undef @files; | ||
83 | } | ||