#//////////////////////////////////////////////////////////////////////////////
#
#  VB�p�v���O�����w�b�_�[�쐬�X�N���v�g
#    2002.10.31 by hnishimura@nsace.co.jp
#
#
#
#
#
#//////////////////////////////////////////////////////////////////////////////

sub findDir {
    # �p�����[�^�A�f�B���N�g����
    my $dir=shift;

    # �f�B���N�g��OPEN���āA�z��֎�荞��
    opendir(DIR,$dir) || (warn("����ȃf�B���N�g���͂Ȃ����I $dir: $!\n") || return);
    my(@filenames) = readdir(DIR);
    closedir(DIR);

    # �z���܂킵��...
    foreach (@filenames) {
        # . �� ..�̓G�X�P�[�v
        next if $_ eq '.';
        next if $_ eq '..';

        # �f�B���N�g�������ׂ�
        $name = "$dir\\$_";
        if (-d $name) {
            # �f�B���N�g���Ȃ�ċA
            #print "$name\n";
            &findDir("$name");

            # ���܂��Ȃ�
            chdir '..';
        }
        else {
            # VB�̃t�@�C����I��
            if ($name=~/\.frm|\.ctl|\.bas|\.cls/) {
                if ($optparam eq 'r') {
                    &ReStore($name);
                }
                else {
                    &InsertHeader($name);
                }
            }
        }
    }
}

sub InsertHeader {
    # �p�����[�^�A�t�@�C����
    my $fname=shift;

    # �t�@�C����z��ɓǂݍ���
    open(IN, $fname);
    @vbfile = <IN>;
    close(IN);

    # ���̃t�@�C������ύX
    rename($fname, $fname."old") || (warn("�t�@�C�����l�[�����s�I $fname: $!\n") || return);
    print "$fname��$fname"."old�փ��l�[�����܂����D�D�D\n";

    $newfile="";    # �o�̓t�@�C���p�o�b�t�@

    # �o�b�t�@����
    @linebuff=();
    $buffcnt=0;

    # 1�s���Ȃ߂܂킵��...
    foreach $line (@vbfile) {

        # �o�b�t�@�ɒǉ�
        if ($buffcnt >= $buffsize) {
            # �o�b�t�@�̐擪�N���A
            shift(@linebuff);
        }
        push(@linebuff, $line);

        # �o�b�t�@��ɃR�����g�炵����̂��Ȃ����`�F�b�N
        $chkflag=0;
        foreach $echobuff (@linebuff) {
            if ($echobuff=~/^\'/) {
                $chkflag++;
            }
        }

        # ��R�����g�Ȃ���΃w�b�_�[�t�^
        if ($chkflag < 1) {

            # ���W���[���̃w�b�_�[
            if ($line=~/^Option Explicit/) {
                $newfile.=$Head1.$line;
            }
            # �֐��̃w�b�_�[
            elsif ($line=~/^Function.+|^Sub.+|^Private Sub.+|^Private Function.+|^Public Sub.+|^Public Function.+/) {
                # �O��
                $newfile.=$Head21;

                # �p�����[�^�̔������
                $parms=$line;
                $parms=~s/^(.*)\(\)(.*)$/$2/g;
                $parms=~s/ByRef//g;
                $parms=~s/ByVal//g;
                $parms=~s/^.*\(//g;
                $parms=~s/\).*$//g;

                $parmchk=$parms;
                $parmchk=~s/\s+//g;
                @PARM=();

                if ($parmchk) {
                    if ($parms=~/^.*,.*$/) {
                        @PARM=split(/,/,$parms);
                    }
                    else {
                        push(@PARM, $parms);
                    }
                    # �p�����[�^�̏o��
                    foreach $arg (@PARM) {
                        $arg=~s/\n//g;
                        @parameter=split(/ As /,$arg);
                        $parameter[0]=~s/\s+//g;
                        $parameter[1]=~s/\s+//g;

                        if ($parameter[0]) {
                            $newfile.="'                $parameter[0]($parameter[1])�F\n";
                        }
                    }
                }
                else {
                    $newfile.="'\n";
                }

                # �㔼
                $newfile.=$Head22.$line;
            }
            # �v���p�e�B�̃w�b�_�[
            elsif ($line=~/^Property.+|^Private Property.+|^Public Property.+/) {
                $newfile.=$Head3.$line;
            }
            # ���̑�
            else {
                $newfile.=$line;
            }
        }
        else {
            $newfile.=$line;
        }

        $buffcnt++;
    }

    # �t�@�C���֏o��
    open(OUT, ">$fname");
        print (OUT $newfile);
    close(OUT);
    print "$fname�ւ̏�����o�͊������܂����D�D�D\n";
}

sub ReStore {
    # �p�����[�^�A�t�@�C����
    my $fname=shift;

    # �t�@�C������ύX
    if ($fname=~/old$/) {
        $newname=$fname;
        $newname=~s/old$//;
        unlink($newname);
        rename($fname, $newname);
        print "$fname��$newname�փ��l�[�����܂����D�D�D\n";
    }
}

########################################
# ���C��

$target_dir = shift;     # ��
$optparam = shift;       # ��
$buffsize=3;             # �o�b�t�@�s

# �w�b�_�[��e�̒�`
$Head1="'====================== MCL �N���W�b�g�^�M�Z���^�[�V�X�e�� ======================\n";
$Head1.="'\n";
$Head1.="'  ��  �e :\n";
$Head1.="'\n";
$Head1.="'  ��  �� :\n";
$Head1.="'\n";
$Head1.="'  �쐬�� :\n";
$Head1.="'\n";
$Head1.="'  ��  �t :\n";
$Head1.="'\n";
$Head1.="'  ��  �l :\n";
$Head1.="'\n";
$Head1.="'================================================================================\n";

$Head21="'*******************************************************************************\n";
$Head21.="'\n";
$Head21.="'  �T  �v :\n";
$Head21.="'\n";
$Head21.="'  �쐬�� :\n";
$Head21.="'\n";
$Head21.="'  �p�����[�^ :\n";

$Head22="'  �߂�l :\n";
$Head22.="'\n";
$Head22.="'  ��  �l :\n";
$Head22.="'\n";
$Head22.="'*******************************************************************************\n";

$Head3="'//\n";
$Head3.="'// �v���p�e�B :\n";
$Head3.="'//\n";

    # �����̋N�_
    &findDir($target_dir);

