view release on metacpan or  search on metacpan

lib/UMLS/Interface/CuiFinder.pm  view on Meta::CPAN

            print STDERR "     MSH\n";
            print STDERR "  Relations (REL):\n";
            print STDERR "     PAR\n";
            print STDERR "     CHD\n\n";
            print STDERR "  Sources (SABDEF):\n";
            print STDERR "     UMLS_ALL\n";
            print STDERR "  Relations (RELDEF):\n";
            print STDERR "     UMLS_ALL\n";
        }
    }
}

#  set the configuration environment variable
#  input :
#  output:
sub _setEnvironmentVariable {

    my $self = shift;

    my $function = "_setEnvironmentVariable";
    &_debug($function);

    #  check self
    if(!defined $self || !ref $self) {
        $errorhandler->_error($pkg, $function, "", 2);
    }

    if($option_verbose) {
        if(! (defined $umlsinterface) ) {
            my $answerFlag    = 0;
            my $interfaceFlag = 0;

            while(! ($interfaceFlag) ) {

                print STDERR "The UMLSINTERFACE_CONFIGFILE_DIR environment\n";
                print STDERR "variable has not been defined yet. Please \n";
                print STDERR "enter a location that the UMLS-Interface can\n";
                print STDERR "use to store its configuration files:\n";

                $umlsinterface = <STDIN>; chomp $umlsinterface;

                while(! ($answerFlag)) {
                    print STDERR "  Is $umlsinterface the correct location? ";
                    my $answer = <STDIN>; chomp $answer;
                    if($answer=~/[Yy]/) {
                        $answerFlag    = 1;
                        $interfaceFlag = 1;
                    }
                    else {
                        print STDERR "Please entire in location:\n";
                        $umlsinterface = <STDIN>; chomp $umlsinterface;
                    }
                }

                if(! (-e $umlsinterface) ) {
                    system "mkdir -m 777 $umlsinterface";
                }

                print STDERR "Please set the UMLSINTERFACE_CONFIGFILE_DIR variable:\n\n";
                print STDERR "It can be set in csh as follows:\n\n";
                print STDERR " setenv UMLSINTERFACE_CONFIGFILE_DIR $umlsinterface\n\n";
                print STDERR "And in bash shell:\n\n";
                print STDERR " export UMLSINTERFACE_CONFIGFILE_DIR=$umlsinterface\n\n";
                print STDERR "Thank you!\n\n";
            }
        }
    }
    else {
        $umlsinterface = "";
    }
}

#  sets the relations, parentRelations and childRelations
#  variables from the information in the config file
#  input : $includerelkeys <- integer
#        : $excluderelkeys <- integer
#        : $includerel     <- reference to hash
#        : $excluderel     <- reference to hash
#  output:
sub _setRelations {

    my $self           = shift;
    my $includerelkeys = shift;
    my $excluderelkeys = shift;
    my $includerel     = shift;
    my $excluderel     = shift;

    my $function = "_setRelations";
    &_debug($function);

    #  check self
    if(!defined $self || !ref $self) {
        $errorhandler->_error($pkg, $function, "", 2);
    }

    #  check the parameters
    if(!(defined $includerelkeys) || !(defined $excluderelkeys) ||
       !(defined $includerel)     || !(defined $excluderel)) {
        $errorhandler->_error($pkg, $function, "REL variables not defined.", 4);
    }

    if($includerelkeys <= 0 && $excluderelkeys <=0) { return; }

    #  if the umls all option is set clear out the the includerel hash and
    #  add the umlsall to the exclude. This way all should be included since
    #  there will never be a source called UMLS_ALL - this is a bit of a dirty
    #  swap but I think it will simplify the code and work
    if(exists ${$includerel}{"UMLS_ALL"}) {
        $includerel = "";             $includerelkeys = 0;
        ${$excluderel}{"UMLS_ALL"} = 1; $excluderelkeys = 1;

    }

    #  set the database
    my $db = $self->{'db'};
    if(!$db) { $errorhandler->_error($pkg, $function, "Error with db.", 3); }

    $parentRelations = "(";
    $childRelations  = "(";
    $relations       = "(";