1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#!/usr/bin/env perl
#
# $FML: list_up_dependence.pl,v 1.1 2003/05/31 04:42:31 fukachan Exp $
#
use strict;
use Carp;
use vars qw(@filter %MODULE %LOCK_CHANNEL);
(@filter) = qw(CGI
Calendar::Lite
Carp
Config
Crypt::UnixCrypt
Data::Dumper
DirHandle
ErrorStatus
Exporter
File::Basename
File::Copy
File::Find
File::Path
File::SimpleLock
File::Spec
File::stat
FileHandle
Fcntl
Getopt::Long
HTML::CalendarMonthSimple
HTML::FromText
IM::EncDec
IM::Iso2022jp
IO::File
IO::Handle
IO::Socket
IPC::Open2
Jcode
MD5
MIME::Lite
MIME::Base64
MIME::QuotedPrint
Mail::Address
Mail::Bounce
Mail::Header
Mail::Message
Socket
Socket6
Something
Term::ReadLine
Tie::JournaledFile
Time::ParseDate
Unicode::Japanese
User::grent
User::pwent);
my $aggregate_to_two_level = 1;
my $shlink_key = defined $ENV{ shlink_key } ? $ENV{ shlink_key } : 1;
my $on = 0;
while (<>) {
if (/^=head/o) { $on = 1;}
if (/^=cut/o) { $on = 0;}
next if $on;
chomp;
if (/LOCK.*CHANNEL:\s*(\S+)/) {
add_channel_entry($ARGV, $1);
}
s/\#.*$//;
if (/(use|require)\s+([A-Z]\S+)/) {
add_entry($ARGV, $2);
}
}
for my $k (sort keys %MODULE) {
my @a = keys %{$MODULE{ $k }};
print "\n";
printf "%-15s %s\n", $k, "";
for my $x (@a) {
printf "%-15s %s\n", "", module($x);
}
}
print "\n--- lock channel list ---\n\n";
for my $k (sort keys %LOCK_CHANNEL) {
printf "%-30s %s\n", $k, $LOCK_CHANNEL{ $k };
}
exit 0;
sub module
{
my ($x) = @_;
my $file = $LOCK_CHANNEL{ $x };
return( $file ? "$x (lock at $file)" : $x);
}
sub _clean_up
{
my ($key) = @_;
$key =~ s@\s*$@@g;
$key =~ s@//@/@g;
$key =~ s@;@@g;
$key =~ s@\}@@g;
$key =~ s@lib/@@g;
return $key;
}
sub add_entry
{
my ($file, $class) = @_;
$file = _clean_up($file);
$class = _clean_up($class);
# cut off the 3rd layer.
if ($shlink_key && $class =~ /::/o) {
my @c = split(/::/, $class);
$class = join("::", $c[0], $c[1]);
}
if ($aggregate_to_two_level) {
my $xfile = $file;
$xfile =~ s@.pm$@@;
$xfile =~ s@/@::@g;
if ($xfile =~ /$class/) {
return;
}
}
unless (ignore($class)) {
$MODULE{ $class }->{ $file } = $file;
}
}
sub add_channel_entry
{
my ($file, $channel) = @_;
$file = _clean_up($file);
$LOCK_CHANNEL{ $file } .= " ".$channel;
}
sub ignore
{
my ($class) = @_;
my $filter = join("|", @filter);
if ($class =~ /^FML/) {
return 1;
}
elsif ($class =~ /^($filter)/) {
return 1;
}
return 0;
}
|
