Код сценария perl, возвращающий исходную папку, не работает - PullRequest
1 голос
/ 27 сентября 2019

Скрипт perl (name: perl1.pl) ищет любые файлы * .obj в текущей папке (папке, в которой находится скрипт perl) и работает с этими файлами.Проблема в том, что код для извлечения текущей папки генерирует ошибку.$ SourceFolder определен в строке 72, и ошибка показывает, когда переменная $ SourceFolder используется в строке 86. Пожалуйста, помогите мне устранить ее.

Я запускаю программу следующим образом: Perl perl1.pl -r 500 -M 10 -s 1 (установка некоторых начальных значений)

(ПРИМЕЧАНИЕ: при запросе папок источника и назначения я нажимаю клавишу возврата, позволяя сценарию использовать текущую папку)

Я получаю следующую ошибку:

открыть исходную папку не удалось!в строке 86 perl1.pl, строке 2.

Похоже, что полный путь не включен в "__FILE_".

Спасибо за любую помощь.

Соответствующий код

print "\Source Folder:";
$SourceFolder=<STDIN>;
chop($SourceFolder);
if (length($SourceFolder)==0) {
    $temp=__FILE__;
    $SourceFolder=substr($temp,0,rindex($temp,"\\")); 
}

Вся программа ниже

use constant PI => 3.1415926535897932384626433832795;

# @AllFiles store all file types in the SourceFolder
@AllFiles,@SourceFiles,@TempSourceFiles,@DestinationFiles;
$i,$OBJFilesCount,$ValueLineCount,$CoverExistFile,$ConversionCount;
@ValueArray,$LineData,@LineValue;
$SourceFolder,$DestinationFolder; 

# The following variables are used to calculate during the conversion
$La,$Lo,$a;
$R,$e,$m,$n,$Alpha,$Beta;
$r,$M,$s;
$X2,@Xs,@Zs,@Ys,@Xd,@Yd,@Zd;
#
# main program
#
# call the help subprogram.
#
&Show_help;
#
# call the read paramter subprogram
#
&Read_parameter;
#
# call the seek SourceFiles subprogram
#
&Seek_SourceFiles;      
$ConversionCount=0;
for ($i=0;$i<$OBJFilesCount;$i++) {
    #
    # call the read SourceFiles subprogram
    # call the create destination filenames subprogram
    #
    &Read_SourceFiles;                             
    &Create_DestinationFiles;  
} 
print "\nThere are $ConversionCount files translated successfully!\n";

#help subprogram
sub Show_help {                        
    if ((lc(@ARGV[0]) eq "-h") or (lc(@ARGV[0]) eq "-help")) {
        open (PATH,"help.hlp") || die ("open help.hlp failed!");        
        while ($LineData=<PATH>) {
            print "$LineData";
        }
        close (PATH);
        exit();
    }
}

# read parameter subprogram
sub Read_parameter {
    # if the pamameter is wrong, Error.
    if ((lc(@ARGV[0]) ne "-r") or (uc(@ARGV[2]) ne "-M") or (lc(@ARGV[4]) ne "-s")) {
        &Parameter_error;                                   
        exit();                  
    }
    # if r,M,s is not a int, Error.
    #  
    if ((@ARGV[1] =~/[a-z]/i) or (@ARGV[1] =~/[!@#""''^&*(){}~_+=-|\/?><,:;]/) or (@ARGV[3] =~/[a-z]/i) or (@ARGV[3] =~/[!@#""''^&*(){}~_+=-|\/?><,:;]/) or (@ARGV[5] =~/[a-z]/i)or (@ARGV[5] =~/[!@#""''^&*(){}~_+=-|\/?><,:;]/) ) {              
        &Parameter_error; 
        exit();
    }                                              
    $r="@ARGV[1]";
    $M="@ARGV[3]";
    $s="@ARGV[5]";
    print "\Source Folder:";
    $SourceFolder=<STDIN>;
    chop($SourceFolder);
    if (length($SourceFolder)==0) {
        $temp=__FILE__;
        $SourceFolder=substr($temp,0,rindex($temp,"\\")); 
    }

    print "Destination Folder:";
    $DestinationFolder=<STDIN>;
    chop($DestinationFolder);
    if (length($DestinationFolder)==0) {
        $temp=__FILE__;
        $DestinationFolder=substr($temp,0,rindex($temp,"\\")); 
    }
}

# Seek SourceFiles
sub Seek_SourceFiles {
    opendir(dirvar,$SourceFolder) || die ("\nopen Source folder failed!");
    #put all of the filenames and subdirectories under the source folder into a ValueArray
    @AllFiles=readdir(dirvar);                 
    closedir(dirvar);
    #Look for *.obj files
    @TempSourceFiles=grep(/.obj/,@AllFiles);   
    #Total numbers of *.obj
    $OBJFilesCount= grep(/.obj/,@AllFiles); 
    #Get all valid obj files.
    $ValidOBJFilesCount=0;
    for ($i=0;$i<$OBJFilesCount;$i++) {
        # Get all of the .obj files in the SourceFolder.
        @temp=split(/ /,"@TempSourceFiles[$i]");
        $Length=@temp;
        #Check the OBJ file valid.
        if($Length==8){
            @SourceFiles[$ValidOBJFilesCount]=@TempSourceFiles[$i];
            $ValidOBJFilesCount++;
        }                          
    }
    $OBJFilesCount=$ValidOBJFilesCount;
    if ($OBJFilesCount==0) {
        print "\bThere are no valid .obj files exist!\b";
        exit();
    }
}

#Get SourceFiles information
sub Read_SourceFiles{
    local @num;
    @ValueArray = split(/ /, @SourceFiles[$i]);
    @num[0]=substr(@ValueArray[1],0,length(@ValueArray[1])-6);
    @num[1]=substr(@ValueArray[1],length(@num[0])+1,2);
    @num[2]=substr(@ValueArray[1],length(@ValueArray[1])-2,2);
    @num[3]=substr(@ValueArray[4],0,length(@ValueArray[4])-6);
    @num[4]=substr(@ValueArray[4],length(@num[3])+1,2);
    @num[5]=substr(@ValueArray[4],length(@ValueArray[4])-2,2);
    #Judge La is a positive or negative number 
    if (substr(@num[0],0,1) eq "-") {
        $La=@num[0]-@num[1]/60-@num[2]/3600;
    }                                            
    else {
        $La=@num[0]+@num[1]/60+@num[2]/3600;
    }
    #Judge Lo is a positive or negative number
    if (substr(@num[3],0,1) eq "-") {   
        $Lo=@num[3]-@num[4]/60-@num[5]/3600;
    }
    else {
        $Lo=@num[3]+@num[4]/60+@num[5]/3600;
    }
    $a=$ValueArray[7]/3600;
    #above change the degrees, minutes and seconds to decimal
    $ValueLineCount=0;
    open (path,"$SourceFolder//@SourceFiles[$i]") || die ("\nopen path failed!\n");
    while ($LineData=<path>) {
        @LineValue=split(/ /,"$LineData");
        #Look for the Values in the file.
        if (index("$LineData","v ")==0) {             
            $ValueLineCount++;
            if ($ValueLineCount==2) {
                #Get the first numeric value in the 2nd ValueLineCount 
                $X2=$LineValue[1];
            }
        }
    }
    close(path);
    #print "\n"; 
}

# Create the destination files
sub Create_DestinationFiles {
    if ($i==0) {
        print "\nTranslation is Processing,please wait......\n";
    }
    open (path,"$SourceFolder//@SourceFiles[$i]") || die ("open path failed!");
    $ValueLineCount=0;
    #Create the destination filename
    @DestinationFiles[$i]=substr (@SourceFiles[$i],0, length(@SourceFiles[$i])-4)." r$r M$M s$s s3.0.0.obj";     
    # Estimate should the program Cover all of the existing destination files.
    if ($CoverExistFile ne "A") {
        # Estimate if the Destination file exists or not.
        if (-e "$DestinationFolder//@DestinationFiles[$i]") {
            print STDERR ("\n@DestinationFiles[$i] exists, do you want to Cover it?[Y/N/All/Quit]");
            $CoverExistFile=<STDIN>;
            chop($CoverExistFile);
            # Cover this Destination file
            if (uc($CoverExistFile) eq "Y") {
                open (PATH,">$DestinationFolder//$DestinationFiles[$i]") || die ("open PATH failed!");
            } 
            # Do not CoverExistFile this Destination file.
            if (uc($CoverExistFile) eq "N") {
                return;
            } 
            # Cover all of the existing Destination files
            if ((uc($CoverExistFile) eq "A") or (uc($CoverExistFile) eq "ALL")) {
                $CoverExistFile="A";                         
                open (PATH,">$DestinationFolder//$DestinationFiles[$i]") || die ("open PATH failed!");
            }
            # Quit the program.
            if ((uc($CoverExistFile) eq "Q") or (uc($CoverExistFile) eq "QUIT")) {
                print "\nThere are $ConversionCount Files Converted Successfully!\n";
                exit();                            
            }
        }
        else {
            open (PATH,">>$DestinationFolder//$DestinationFiles[$i]") || die ("open PATH failed!");
        }
    }
    else {
        open (PATH,">$DestinationFolder//$DestinationFiles[$i]") || die ("open PATH failed!");
    }
    # Find the details of source file and calculate the values
    $ConversionCount++;
    while ($LineData=<path>) {
        @LineValue=split(/ /,"$LineData");
        if (index("$LineData","# object ")==0) {
            print PATH ("# Converted by Utility Version 3.0.0\n");
            print PATH ("# comment\n");
        }
        if (index("$LineData","v ")==0) {
            $ValueLineCount++;
            @Xs[ValueLineCount]=$LineValue[1];
            @Zs[ValueLineCount]=$LineValue[2];
            @Ys[ValueLineCount]=$LineValue[3];
            $n=sprintf("%.0f",(@Ys[ValueLineCount]/$X2));
            $m=sprintf("%.0f",(@Xs[ValueLineCount]/$X2));
            $Alpha=$La-$n*$a;
            $Beta=$Lo+$m*$a;
            if (@Zs[ValueLineCount]==0) {
                $e=0;
                $s=0;
            }
            else {
                $e=$Zs[ValueLineCount]*$M;
            }
            $R=$s+$r*(1+$e/6370997);
            @Xd[ValueLineCount]=$R*cos($Alpha*PI/180)*sin($Beta*PI/180);
            @Yd[ValueLineCount]=-$R*cos($Alpha*PI/180)*cos($Beta*PI/180);
            @Zd[ValueLineCount]=$R*sin($Alpha*PI/180);
            # Output the calculated values to the destination files and hold 8 decimal places 
            print PATH ("v ");
            printf PATH ("%.8f ",@Xd[ValueLineCount]);
            printf PATH ("%.8f ",@Yd[ValueLineCount]);
            printf PATH ("%.8f",@Zd[ValueLineCount]);
            print PATH ("\n");
        }
        else
        {
            # Output unchanged data to the destination file.
            print PATH ("@LineValue");          
        }   
    }
    close(PATH);
    close(path);
    print "Translate File:@DestinationFiles[$i] completed!\n";
}

# Parameter Error Subprogram
sub Parameter_error {
    print "\nVersion 3.0.0\n";
    print "Use for ActiveState (R) Active Perl Version 5.6.0\n";
    print "Copyright (C) 2000-2019.\n";
    print "\nInput Parameter Error,Please use Command (Translating.pl -h)\nto get help information!\n";
}

1 Ответ

3 голосов
/ 27 сентября 2019

Получение полного пути к сценарию является целью ядра FindBin module

use warnings;
use strict;
use feature 'say';

use FindBin qw($RealBin);

say $RealBin;

Пожалуйста, внимательно изучите документы на предмет возможных тонкостей в конкретном случае использования.

Всегда запускайте свои программы с use warnings; и use strict;.


Существует также более старый, "проверенный и верный" способ

use Cwd qw(abs_path);
use File::Basename qw(dirname);

say dirname( abs_path($0) );

, где я использовал $0 переменную вместо специального литерала __FILE__.Если тонкости имеют значение в вашем использовании, пожалуйста, сравните внимательно, так как они немного отличаются.

Хотя это обычно используется для самой длинной заметки времени из File :: Basename docs

  • dirname
    Эта функция предназначена для совместимости с командой оболочки Unix dirname(1) и унаследовала некоторые из ее особенностей.Несмотря на свое имя, NOT всегда возвращает имя каталога, как и следовало ожидать.На всякий случай, если вы хотите, чтобы в качестве имени каталога использовался путь, используйте fileparse().

(оригинальный акцент). Так что все может стать немного сложнее.


Тогда есть еще другие модули для работы с файловой системой, которые можно найти в CPAN.Мне легко порекомендовать очень полезный Path :: Tiny , с помощью которого мы можем сделать для этой работы

use Path::Tiny;

say path($0)->realpath->parent;

(я считаю, что заказ parent->realpath также работает нормально)

Как говорят доктора, это вариант " более дорогой ", чем метод absolute, но он не разрешит 'd1/../d2' в канонические пути, если File::Spec не включенэта платформа.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...