[原创代码] [Perl]列举MinGW中指定C语言库的依赖关系

523066680

初始版本，做了格式化输出。

示例库文件： "windows.h"
相关目录保存于 @dirs 数组中

备注：如果一个函数库已经出现过，则忽略，避免进入死循环
     if ($Lv < 5) { 设定最大递归层，可不设限

=info
    523066680@163.com
    2015-06-09
=cut
 
our @dirs = (
    "C:/MinGW/lib/gcc/mingw32/4.7.2/include",
    "C:/MinGW/Include"
);
 
our %name;
our %hash;
 
my $headfile = "windows.h";
func(0, ".", $headfile);
tree(\%hash);
 
sub func {
    our @dirs;
    our %hash;
    our %name;
    my $fullpath;
    my ($Lv, $parent, $fname) = @_;
    my @all;
 
    return if (exists $name{$fname});
    $name{$fname} = 1;
    $hash{$parent.":".$fname} = $Lv;
 
    foreach (@dirs) {
        $fullpath = "$_/$fname" if (-e "$_/$fname");
    }
    return 0 if (! defined $fullpath);
    ReadFile(\@all, $fullpath);
 
    foreach (@all) {
        if (/#include <(.*)>/) {
            if ($Lv < 5) {
                func($Lv+1, $parent.":".$fname, $1);
            }
        }
    }
}
 
sub tree {
    my $ref = shift;
    my ($a, $b);
    my ($e, $v) = (-1, undef);
 
    foreach (sort keys %$ref) {
        $v = $ref->{$_};
        s/(.*:)([^:]+)$/$2/;
        
        if ( $v <= $e) {
            print "\n" . " "x(length($1) - $v - 2  + ($v)*3);
        }
        print " > " . $2;
        $e = $v;
    }
}
 
sub ReadFile {
    my ($aref, $fullpath) = (shift, shift);
    open READ, "<", $fullpath or die "$!\n";
    @{$aref} = <READ>;
    close READ;
}COPY

> windows.h > _mingw.h > sdkddkver.h
             > cderr.h
             > commdlg.h > unknwn.h > objfwd.h
                                    > wtypes.h > rpcndr.h > rpcnsip.h
             > ddeml.h
             > imm.h
             > lzexpand.h
             > mmsystem.h
             > nb30.h
             > ole2.h > objbase.h > cguid.h
                                  > objidl.h
                                  > stdlib.h
                      > oleauto.h > oaidl.h
                      > olectlid.h
                      > oleidl.h
             > rpc.h > excpt.h
                     > rpcdce.h > basetyps.h
                                > rpcdcep.h
                     > rpcnsi.h
                     > rpcnterr.h
             > shellapi.h > pshpack2.h
             > stdarg.h
             > winbase.h
             > wincon.h
             > windef.h
             > wingdi.h
             > winnetwk.h
             > winnls.h
             > winperf.h
             > winreg.h > reason.h
             > winresrc.h > commctrl.h > prsht.h
                          > dde.h
                          > dlgs.h
                          > winnt.h > basetsd.h
                                    > poppack.h
                                    > pshpack4.h
                                    > string.h > stddef.h > machine/ansi.h
                                                          > sys/_types.h
                                    > winerror.h
                          > winuser.h
                          > winver.h
             > winsock.h > mswsock.h
             > winspool.h
             > winsvc.h

523066680

修正问题： 正则表达式（考虑部分#include 采用的是 双引号，以及#include 尾部含有注释<>""的情况）
.

=info
    523066680@163.com
    2015-06-09
=cut
 
use feature 'state';
 
our @dirs = (
    "C:/MinGW/lib/gcc/mingw32/4.7.2/include",
    "C:/MinGW/Include",
);
 
our %name;
our %hash;
 
my $headfile = "windows.h";
func(0, ".", $headfile);
 
sub func {
    our @dirs;
    our %name;
    my $fullpath;
    my ($Lv, $parent, $fname) = @_;
    my @all;
 
    foreach (@dirs) {
        if (-e "$_/$fname") {
            $fullpath = "$_/$fname";
        }
    }
 
    return if (exists $name{$fname});
    return if (! defined $fullpath);
 
    $name{$fname} = 1;
    Xprint($Lv, $parent, $fname);
    ReadFile(\@all, $fullpath);
 
    foreach (@all) {
        if (/#include ["<](.*?)[">]/) {
            func($Lv+1, $parent.":".$fname, $1);
        }
    }
}
 
sub Xprint {
    state $e = -1;
    my ($Lv, $parent, $fname) = @_;
    if ( $Lv <= $e) {
        print "\n";
        print " "x(length($parent) + ($Lv)*2 - 1);
    }
    print " > " . $fname;
    $e = $Lv;
}
 
sub ReadFile {
    my ($aref, $fullpath) = (shift, shift);
    open READ, "<", $fullpath or die "$!\n";
    @{$aref} = <READ>;
    close READ;
}COPY

> windows.h > _mingw.h > sdkddkver.h
             > winresrc.h > winuser.h
                          > winnt.h > winerror.h
                                    > string.h > stddef.h
                                    > basetsd.h
                                    > pshpack4.h
                                    > poppack.h
                          > winver.h
                          > dde.h
                          > dlgs.h
                          > commctrl.h > prsht.h
             > stdarg.h
             > windef.h
             > wincon.h
             > winbase.h
             > wingdi.h
             > winnls.h
             > winnetwk.h
             > winreg.h > reason.h
             > winsvc.h
             > cderr.h
             > ddeml.h
             > imm.h
             > lzexpand.h
             > mmsystem.h
             > nb30.h
             > rpc.h > rpcdce.h > basetyps.h
                                > rpcdcep.h
                     > rpcnsi.h
                     > rpcnterr.h
                     > excpt.h
             > shellapi.h > pshpack2.h
             > winperf.h
             > commdlg.h > unknwn.h > objfwd.h
                                    > wtypes.h > rpcndr.h > rpcnsip.h
             > winspool.h
             > winsock.h > mswsock.h
             > ole2.h > objbase.h > stdlib.h
                                  > objidl.h
                                  > cguid.h
                      > olectlid.h
                      > oleauto.h > oaidl.h
                      > oleidl.h

523066680

最近看到类似问题，发现以前的代码有一些写的不好的地方，更新一下

• 增加递归层级限制
  
• for循环不再使用匿名变量$_
  

=info
    523066680@163.com
    2015-06-09
    Update: 2022-03-27
=cut
 
use File::Slurp;
STDOUT->autoflush(1);
 
our $MAX_LEVEL = 6; # 递归层级
our @dirs = (       # 搜索范围
   "C:/MinGW/x86_64-w64-mingw32/include",
   "C:/MinGW/Include",
);
 
our %names;
our %tree;
 
my $headfile = "windows.h";
recur(0, ".", $headfile);
dumptree(\%tree);
 
sub recur 
{
    my ($lv, $parent, $fname) = @_;
    my @all;
 
    return if (exists $names{$fname});    # 确保库文件名只处理一次
    $names{$fname} = 1;
    $tree{$parent." > ".$fname} = [ $parent, $fname, $lv];
 
    my $fullpath;
    # 遍历备选地址，找到包含该库文件的路径
    grep { $fullpath = "$_/$fname" if -f "$_/$fname" } @dirs;
    return 0 if (! defined $fullpath);
 
    my @lines = read_file( $fullpath );
    for my $e ( @lines ) 
    {
        if ( $e =~ /#include\s+["<](.*)[">]/ and $lv < $MAX_LEVEL ) 
        {
            recur($lv+1, $parent." > ".$fname, $1);
        }
    }
}
 
sub dumptree 
{
    my $tree = shift;
    my $level = -1;
    for my $fullpath (sort keys %$tree) 
    {
        my ($path, $fname, $v) = @{$tree->{$fullpath}};
 
        # 同级或者向上层级，打印前置缩进；子级不换行，递进显示
        print "\n" . " "x(length($path)-1) if $v <= $level;
        print " > " . $fname;
        $level = $v;
    }
}COPY