lib/tool_subs.pm

   1 # {{{ include
   2
   3 start include statements
   4 use ext::Parallel::ForkManager;
   5 use strict;
   6 use Cwd;
   7 use File::Copy 'cp';
   8 use OSspecific;
   9 use Storable;
  10 use Math::Random;
  11 use ui;
  12 use Data::Dumper;
  13 use Config;
  14 our $AUTOLOAD;
  15 if ( $PsN::config -> {'_'} -> {'use_database'} ) {
  16 # Testing DBD::mysql:
  17   require DBI;
  18 }
  19 end include
  20
  21 # }}} include statements
  22
  23 # {{{ new
  24
  25 start new
  26 {
  27     # The I<retries>, I<picky>, I<nm_version>, I<seed> and I<threads>
  28     # attributes can be specified as either a scalar or as an
  29     # array. The scalar value will be applied to all models whereas
  30     # the array holds values per model. If an array is given it must
  31     # be of the same length as the number of models.
  32     #
  33     # The I<directory> is the folder where the tools stores
  34     # temporary data and runs subtools (or in the modelfit case,
  35     # runs NONMEM). If unsure of what this means, leave it undefined
  36     # and a default will be used, e.g. modelfit_dir3 or something.
  37     #
  38     # The base_directory refers to the directory where the tool
  39     # should place its own directory. Default is current directory.
  40     #
  41     # A more interresting attribute is I<threads> which sets how many
  42     # parallel executions of NONMEM that will run. Some tips are:
  43     # Setting the number of threads higher than the number of nodes in
  44     # your cluster/supercomputer can make your runs slower. The
  45     # biggest limiting factor is the amount of memory needed by
  46     # NONMEM. With smaller runs, just set the thread number to the
  47     # number of nodes available.
  48     #
  49     # The I<directory> is the folder where the tools stores
  50     # temporary data and runs subtools (or in the modelfit case,
  51     # runs NONMEM). Each NONMEM run will have its own sub directory
  52     # NM_run[X] where [X] is an index running from 0 to the number of
  53     # runs-1. If unsure of what this means, leave it undefined and a
  54     # default will be used, e.g. modelfit_dir3 or something.
  55     #
  56     # Next, the I<compress> and I<remove_temp_files> attributes are good
  57     # if you want to save some hard disk space. I<compress> set to 1
  58     # will put all NONMEM output in to an tar/gz archive named
  59     # I<problem_files.tgz> placed in the I<NM_run[X]> directory
  60     # described above. If I<remove_temp_files> is set to 1, the NONMEM
  61     # files: 'FCON', 'FDATA', 'FSTREAM', 'PRDERR' will be removed.
  62     #
  63     # I<clean> is a stronger version of I<remove_temp_files>; it will also
  64     # remove I<NM_run[X]> and all that is in these.
  65     #
  66     # I<retries> is the number of times L</run> will alter initial
  67     # values and (re)execute NONMEM when executions fail. I<retries>
  68     # can either be an integer, specifying the number of retries for
  69     # all models, or it can be an array with the number of retries
  70     # specific for each modelfile as elements. The default value is
  71     # B<5>. The algorithm for altering the initial values works
  72     # roughly like this: For each each new try, a random new initial
  73     # value is drawn from a uniform distribution with limits +-n*10%
  74     # of the original intial estimate and where n i equal to the retry
  75     # number. I.e. the first retry, the borders of the distribution
  76     # are +-10%. The algorithm ensures that the new values are within
  77     # specified boundaries.
  78     #
  79     # =begin html
  80     #
  81     # For a full dexcription of the algorithm, see <a
  82     # href="model/problem/record/init_option.html#set_random_init">set_random_init</a>
  83     # of the <a
  84     # href="model/problem/record/init_option.html">init_option
  85     # class</a>.
  86     #
  87     # =end html
  88     #
  89     # =begin man
  90     #
  91     # For a full dexcription of the algorithm, see I<set_random_init>
  92     # of the I<init_option> class.
  93     #
  94     # =end man
  95     #
  96     # If I<picky> is set to 1, the output from NONMEM will be checked
  97     # more thoroughly. If any of the lines below are found in the
  98     # minimization message, a rerun is initiated.
  99     #
 100     #    ESTIMATE OF THETA IS NEAR THE BOUNDARY AND
 101     #    PARAMETER ESTIMATE IS NEAR ITS BOUNDARY
 102     #    R MATRIX ALGORITHMICALLY SINGULAR
 103     #    S MATRIX ALGORITHMICALLY SINGULAR
 104     #
 105     # I<nm_version> is a string with the version number of NONMEM that
 106     # will be used. The installed versions of NONMEM must be specified
 107     # in OSspecific.pm, the class responsible for system specific
 108     # features settings.
 109     #
 110     # I<logfile> specifies the name of the logfile.
 111     #
 112     # If I<debug> is set to 1(true), (many!) debug messages will be
 113     # printed.
 114     #
 115     # I<extra_files> is an array of strings where each string is a
 116     # file needed for NONMEM execution. Those file will be moved
 117     # to the I<NM_run[X]> directory.
 118     #
 119     # I<seed> is just a way to set a seed number.
 120     #
 121     # If a directory is given as argument to a tool, it will extract
 122     # all information about what has already been run in this
 123     # directory and continue there. If nothing is left to do, it will
 124     # still produce the output as a normal run would. This is useful
 125     # both for resuming crashed runs as well as for extracting
 126     # information form an old run.
 127
 128   $this -> {'seed'} = defined $parm{'seed'} ? $parm{'seed'} : random_uniform_integer(1,0,10000000);
 129
 130         #Initiate the random generator if a seed is given (which it is, see above)
 131         random_set_seed_from_phrase( $this -> {'seed'} );
 132
 133         # The base_directory refers to the directory where the tool should place its own
 134         # directory
 135         if ( defined $parm{'base_directory'} ) {
 136           $this -> {'base_directory'} = $parm{'base_directory'};
 137         } else {
 138           my ($uniquePath, $file) = OSspecific::absolute_path( '', '' );
 139           $this -> {'base_directory'} = $uniquePath;
 140         }
 141
 142         my @tool_name_full = split( '::', ref $this );
 143         my $tool_name = $tool_name_full[$#tool_name_full];
 144
 145         # The directory is the folder where the tools stores temporary data and
 146         # runs subtools (or in the modelfit case, runs NONMEM)
 147         if ( defined $parm{'directory'} ) {
 148           my $dummy;
 149           ( $this -> {'directory'}, $dummy ) = OSspecific::absolute_path( $parm{'directory'}, '');
 150         } else {
 151           my $file;
 152           $this -> {'directory'} =
 153               OSspecific::unique_path( $tool_name.'_dir' ,
 154                                        $this -> {'base_directory'} );
 155         }
 156
 157   # Create my temporary directory
 158   $this -> _make_dir;
 159   if ( $PsN::config -> {'_'} -> {'use_database'} ) {
 160     my( $found_log, $found_tool_id ) = $this -> read_log;
 161
 162     $this -> register_in_database unless ( $found_tool_id );
 163
 164     $this -> log_object unless ( $found_log and $found_tool_id );
 165   }
 166
 167         debug -> die( message => "No model specified!" )
 168             unless ( defined $this -> {'models'} and scalar @{$this -> {'models'}} > 0 );
 169         foreach my $mod ( @{$this -> {'models'}} ) {
 170           debug -> die( message => "Supplied argument model is not defined" )
 171               unless defined $mod;
 172         }
 173         # Make sure that the filenames are absolute and collect model_ids
 174         my @model_ids;
 175         foreach my $model ( @{$this -> {'models'}} ) {
 176           my $model_id = $model -> model_id;
 177           if( not defined $model_id ) {
 178             $model_id = $model -> register_in_database;
 179           }
 180           my $datas = $model -> datas;
 181           if( defined $datas ) {
 182             foreach my $data ( @{$datas} ) {
 183               my $data_id = $data -> data_id;
 184               if( not defined $data_id ) {
 185                 $data -> register_in_database;
 186               }
 187             }
 188           }
 189
 190           push( @model_ids, $model -> model_id );
 191             my ($directory, $filename) = OSspecific::absolute_path( $model -> directory, $model -> filename );
 192             $model -> filename( $filename );
 193             $model -> directory( $directory );
 194           if ( defined $model -> outputs ) {
 195             my @outputs = @{$model -> outputs};
 196             foreach my $output ( @outputs ) {
 197                 my ($directory, $filename) = OSspecific::absolute_path( $outputs[0] -> directory, $outputs[0] -> filename );
 198                 $output -> filename( $filename );
 199                 $output -> directory( $directory );
 200             }
 201           }
 202           if ( defined $model -> datas ) {
 203             my @datas = @{$model -> datas};
 204             foreach my $data ( @datas ) {
 205                 my ($directory, $filename) = OSspecific::absolute_path( $datas[0] -> directory, $datas[0] -> filename );
 206                 $data -> filename( $filename );
 207                 $data -> directory( $directory );
 208             }
 209           }
 210         }
 211   $this -> {'model_ids'} = \@model_ids;
 212   if ( not -e $this -> {'directory'}."done.database.tool_models" ) {
 213     $this -> register_tm_relation( model_ids       => \@model_ids,
 214                                    prepared_models => 0 );
 215     open( DB, ">".$this -> {'directory'}."done.database.tool_models" );
 216     print DB "";
 217     close( DB );
 218   }
 219 }
 220 end new
 221
 222 # }}} new
 223
 224 # {{{ log_object
 225 start log_object
 226 {
 227   open( OLOG, '>',$self -> {'directory'}.'object.txt' );
 228   $Data::Dumper::Maxdepth = 1;
 229   print OLOG Dumper $self;
 230   $Data::Dumper::Maxdepth = 0;
 231   close( OLOG );
 232 }
 233 end log_object
 234 # }}} log_object
 235
 236 # {{{ read_log
 237 start read_log
 238 {
 239   if( -e $self -> {'directory'}.'object.txt' ) {
 240     $found_log = 1;
 241     open( OLOG, '<'.$self -> {'directory'}.'object.txt' );
 242     my @olog = <OLOG>;
 243     my $str = "(";
 244     for ( my $i = 1; $i < $#olog; $i++ ) {
 245       $str = $str.$olog[$i];
 246     }
 247     $str = $str.")";
 248     my %tmp = eval( $str );
 249
 250     if( exists $tmp{'tool_id'} ) {
 251       $self -> {'tool_id'} = $tmp{'tool_id'};
 252       $found_tool_id = 1;
 253     }
 254     close( OLOG );
 255   }
 256 }
 257 end read_log
 258 # }}} read_log
 259
 260
 261 # {{{ register_in_database
 262 start register_in_database
 263   {
 264     if ( $PsN::config -> {'_'} -> {'use_database'} ) {
 265       my @tool_name_full = split( '::', ref $self );
 266       my $tool_name = $tool_name_full[$#tool_name_full];
 267       my ( $date_str, $time_str );
 268       if ( $Config{osname} eq 'MSWin32' ) {
 269         $date_str = `date /T`;
 270         $time_str = ' '.`time /T`;
 271       } else {
 272         # Assuming UNIX
 273         $date_str = `date`;
 274       }
 275       chomp($date_str);
 276       chomp($time_str);
 277       my $date_time = $date_str.$time_str;
 278       # Backslashes messes up the sql syntax
 279       my $dir_str = $self->{'directory'};
 280       $dir_str =~ s/\\/\//g;
 281
 282       my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
 283                                ";databse=".$PsN::config -> {'_'} -> {'project'},
 284                                $PsN::config -> {'_'} -> {'user'},
 285                                $PsN::config -> {'_'} -> {'password'},
 286                                {'RaiseError' => 1});
 287       my $sth;
 288       if ( defined $self -> {'parent_tool_id'} ) {
 289         #           print "INSERT INTO tool (parent_tool_id,name,date,directory) ".
 290         #             "VALUES (".$self -> {'parent_tool_id'}.", '".
 291         #               "$tool_name', '$date_time', '$dir_str' )\n";
 292         $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
 293                                ".tool (parent_tool_id,name,date,directory) ".
 294                                "VALUES (".$self -> {'parent_tool_id'}.", '".
 295                                "$tool_name', '$date_time', '$dir_str' )");
 296       } else {
 297         $sth = $dbh -> prepare("INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
 298                                ".tool (name,date,directory) ".
 299                                "VALUES ('$tool_name', '$date_time', '$dir_str' )");
 300       }
 301       $sth -> execute;
 302       $self -> {'tool_id'} = $sth->{'mysql_insertid'};
 303       $sth -> finish;
 304       $dbh -> disconnect;
 305     }
 306   }
 307 end register_in_database
 308 # }}} register_in_database
 309
 310 # {{{ register_tm_relation
 311 start register_tm_relation
 312   if ( $PsN::config -> {'_'} -> {'use_database'} and
 313        defined $self -> {'tool_id'} and $#model_ids >= 0 ) {
 314     my $dbh = DBI -> connect("DBI:mysql:host=".$PsN::config -> {'_'} -> {'database_server'}.
 315                              ";databse=".$PsN::config -> {'_'} -> {'project'},
 316                              $PsN::config -> {'_'} -> {'user'},
 317                              $PsN::config -> {'_'} -> {'password'},
 318                              {'raiseerror' => 1});
 319     my $sth;
 320     my $values;
 321     my $columns = "( tool_id, model_id, prepared_model )";
 322     foreach my $model_id ( @model_ids ) {
 323       if ( defined $model_id ) {
 324         $values = $values."," if ( defined $values );
 325         if( $prepared_models ) {
 326           $values = $values."(".$self -> {'tool_id'}.", $model_id, 1 )";
 327         } else {
 328           $values = $values."(".$self -> {'tool_id'}.", $model_id, 0 )";
 329         }
 330       }
 331     }
 332     $sth = $dbh -> prepare( "INSERT INTO ".$PsN::config -> {'_'} -> {'project'}.
 333                                ".tool_model $columns VALUES $values" );
 334     $sth -> execute;
 335     $sth -> finish if ( defined $sth );
 336     $dbh -> disconnect;
 337   }
 338 end register_tm_relation
 339 # }}} register_tm_relation
 340
 341 # {{{ copy
 342
 343 start copy
 344 #      {
 345         #%{$tool} = %{$self};
 346         #$tool -> {'models'} = undef;
 347         #$tool -> {'tools'} = undef;
 348         #@{$tool -> {'models'}} = ();
 349         #@{$tool -> {'tools'}} = ();
 350         #foreach my $model ( @{$self -> {'models'}} ) {
 351         #  push( @{$tool -> {'models'}}, $model -> copy );
 352         #}
 353         #foreach my $subtool ( @{$self -> {'tools'}} ) {
 354         #  push( @{$tool -> {'tools'}}, $subtool -> copy );
 355         #}
 356         #bless( $tool, ref( $self ) );
 357
 358         # ! NOTE ! This is not a deep copy ! NOTE !
 359         # This function has now been replaced with "copying" the "reference object" in new().
 360
 361 #       my $all_parameters = {};
 362
 363 #       foreach my $valid_p ( keys %{ $self -> {'__valid_parameters'} } ){
 364 #         if( defined $self -> {$valid_p} ) {
 365 #           $all_parameters -> {$valid_p} = $self -> {$valid_p};
 366 #         }
 367 #       }
 368
 369 #       %{$all_parameters} = (%{$all_parameters}, %parameters);
 370
 371 #       use Data::Dumper;
 372 #       $Data::Dumper::Maxdepth = 3;
 373 #       print Dumper( $all_parameters );
 374 #       $Data::Dumper::Maxdepth = 0;
 375
 376 #       my $tool_string = ref $self;
 377
 378 #       $tool = "$tool_string" -> new( %{$all_parameters} );
 379 #      }
 380 end copy
 381
 382 # }}} copy
 383
 384 # {{{ pre_fork_setup
 385
 386 start pre_fork_setup
 387       {
 388         # Runs the pre_fork_setup specific for the subtool
 389         my $sub_pre_fork_setup = $self -> {'subtools'} -> [0];
 390         if ( defined $sub_pre_fork_setup ) {
 391           $sub_pre_fork_setup = $sub_pre_fork_setup.'_pre_fork_setup';
 392           if ( defined( $self -> can( $sub_pre_fork_setup ) ) ) {
 393             $self -> $sub_pre_fork_setup;
 394           }
 395         }
 396       }
 397 end pre_fork_setup
 398
 399 # }}} pre_fork_setup
 400
 401 # {{{ print_results
 402
 403 start print_results
 404       {
 405         # Run the print_results specific for the subtool
 406         my $sub_print_results = $self -> {'subtools'} -> [0];
 407         if ( defined $sub_print_results ) {
 408           # Bortkommenterat just nu (2004-10-10) skall användas senare
 409 #         $sub_print_results = $sub_print_results.'_results';
 410 #         if ( defined( $self -> can( $sub_print_results ) ) ) {
 411 #           $self -> $sub_print_results( @_ );
 412 #         } else {
 413             sub get_dim {
 414               my $arr      = shift;
 415               my $dim      = shift;
 416               my $size_ref = shift;
 417               $dim++;
 418               if ( defined $arr and ref($arr) eq 'ARRAY' ) {
 419                 push( @{$size_ref}, scalar @{$arr} );
 420                 ( $dim, $size_ref ) = get_dim( $arr->[0], $dim, $size_ref );
 421               }
 422               return ( $dim, $size_ref );
 423             }
 424             sub format_value {
 425               my $val = shift;
 426               if ( not defined $val or $val eq '' ) {
 427                 return sprintf("%10s",$PsN::output_style).',';
 428               } else {
 429                 $_ = $val;
 430                 my $nodot = /.*\..*/ ? 0 : 1;
 431                 $_ =~ s/\.//g;
 432                 if ( /.*\D+.*/ or $nodot) {
 433                   return sprintf("%10s",$val).',';
 434                 } else {
 435                   return sprintf("%10.5f",$val).',';
 436                 }
 437               }
 438             }
 439             debug -> die( message => "No results_file defined" )
 440                 unless ( defined $self -> {'results_file'} );
 441             open ( RES, ">".$self -> {'directory'}.$self -> {'results_file'} );
 442             if ( defined $self -> {'results'} ) {
 443               my @all_results = @{$self -> {'results'}};
 444               for ( my $i = 0; $i <= $#all_results; $i++ ) {
 445                 if ( defined $all_results[$i]{'own'} ) {
 446                   my @my_results = @{$all_results[$i]{'own'}};
 447                   for ( my $j = 0; $j <= $#my_results; $j++ ) {
 448                     # These size estimates include the problem and sub_problem dimensions:
 449                     my ( $ldim, $lsize_ref ) = get_dim( $my_results[$j]{'labels'}, -1, [] );
 450                     my ( $vdim, $vsize_ref ) = get_dim( $my_results[$j]{'values'}, -1, [] );
 451 #                   print $my_results[$j]{'name'}," $ldim (",join(' ',@{$lsize_ref}),") ",
 452 #                     "$vdim (",join(' ',@{$vsize_ref}),")\n";
 453                     print RES $my_results[$j]{'name'},"\n" if ( $vdim > 1 );
 454                     # Loop the problems:
 455                     if ( defined $my_results[$j]{'values'} and
 456                          scalar @{$my_results[$j]{'values'}} >= 0 ) {
 457                       my @probs  = @{$my_results[$j]{'values'}};
 458                       my @labels;
 459                       if ( defined $my_results[$j]{'labels'} and
 460                            scalar @{$my_results[$j]{'labels'}} >= 0 ) {
 461                         @labels = @{$my_results[$j]{'labels'}};
 462                       }
 463                       for ( my $prob = 0; $prob <= $#probs; $prob++ ) {
 464                         print RES "PROBLEM ",$prob+1,"\n" unless ( $#probs == 0 );
 465                         # Loop the sub_problems
 466                         for ( my $subp = 0; $subp < scalar @{$probs[$prob]}; $subp++ ) {
 467                           print RES "SUBPROBLEM ",$subp+1,"\n"
 468                             unless ( scalar @{$probs[$prob]} == 1 );
 469                           # Print Header Labels
 470                           if ( $ldim == 2 ) {
 471                             my $label = $labels[$prob][$subp];
 472                             print RES ','.format_value($label),"\n";
 473 #                             if ( defined $label and $label ne '' );
 474                           } elsif ( $ldim == 4 ) {
 475                             print RES ',';
 476                             for ( my $n = 0; $n < scalar @{$labels[$prob][$subp][1]}; $n++ ) {
 477                               my $label = $labels[$prob][$subp][1][$n];
 478                               print RES format_value($label);
 479 #                               if ( defined $label and $label ne '' );
 480                             }
 481                             print RES "\n" if ( scalar @{$labels[$prob][$subp][1]} );
 482                           }
 483                           # Print the values:
 484                           if ( $vdim == 2 ) {
 485                               print RES ','.format_value($probs[$prob][$subp]),"\n";
 486 #                             if ( defined $probs[$prob][$subp] and
 487 #                                  $probs[$prob][$subp] ne '' );
 488                           } elsif ( $vdim == 3 ) {
 489                             for ( my $m = 0; $m < scalar @{$probs[$prob][$subp]}; $m++ ) {
 490                               my $label = $labels[$prob][$subp][$m];
 491                               print RES ','.format_value($label);
 492 #                               if ( defined $label and $label ne '' );
 493                               my $val = $probs[$prob][$subp][$m];
 494                               print RES ','.format_value($val),"\n";
 495 #                               if ( defined $val and $val ne '' );
 496                             }
 497                           } elsif ( $vdim == 4 ) {
 498                             for ( my $m = 0; $m < scalar @{$probs[$prob][$subp]}; $m++ ) {
 499                               my $label;
 500                               if ( $ldim == 3 ) {
 501                                 $label = $labels[$prob][$subp][$m];
 502                               } elsif ( $ldim == 4 ) {
 503                                 $label = $labels[$prob][$subp][0][$m];
 504                               }
 505 #                             if ( defined $label and $label ne '' ) {
 506                                 print RES format_value($label);
 507 #                             } else {
 508 #                               print RES ',';
 509 #                             }
 510                               if( defined $probs[$prob][$subp][$m] ){
 511                                 for ( my $n = 0; $n < scalar @{$probs[$prob][$subp][$m]}; $n++ ) {
 512                                   print RES format_value($probs[$prob][$subp][$m][$n]);
 513 #                                     if ( defined $probs[$prob][$subp][$m][$n] and
 514 #                                          $probs[$prob][$subp][$m][$n] ne '' );
 515                                 }
 516                               }
 517                               print RES "\n";
 518                             }
 519                           }
 520                         }
 521                       }
 522                     }
 523                   }
 524                 }
 525               }
 526             }
 527             close( RES );
 528 # Bortkommenterat 2004-10-10, se ovan
 529 #         }
 530         } else {
 531           debug -> warn( level => 2,
 532                          message => "No subtools defined".
 533                          ", using default printing routine" );
 534         }
 535       }
 536 end print_results
 537
 538 # }}} print_results
 539
 540 # {{{ post_fork_analyze
 541
 542 start post_fork_analyze
 543       {
 544         # Runs the post_fork_analyze specific for the subtool
 545         my $sub_post_fork_analyze = $self -> {'subtools'} -> [0];
 546         if ( defined $sub_post_fork_analyze ) {
 547           $sub_post_fork_analyze = $sub_post_fork_analyze.'_post_fork_analyze';
 548           if ( defined( $self -> can( $sub_post_fork_analyze ) ) ) {
 549             $self -> $sub_post_fork_analyze;
 550           }
 551         }
 552         if ( defined $self -> {'results_file'} ) {
 553           #$self -> print_results;
 554         }
 555       }
 556 end post_fork_analyze
 557
 558 # }}} post_fork_analyze
 559
 560 # {{{ setup
 561
 562 start setup
 563       {
 564         $self -> _prepare_model( model_number => $model_number );
 565
 566         # Run the setup specific for the subtool
 567         my $sub_setup = $self -> {'subtools'} -> [0];
 568         if ( defined $sub_setup ) {
 569           $sub_setup = $sub_setup.'_setup';
 570           $self -> $sub_setup( model_number => $model_number );
 571         }
 572       }
 573 end setup
 574
 575 # }}} setup
 576
 577 # {{{ _make_dir
 578
 579 start _make_dir
 580        {
 581          mkdir( $self -> {'directory'} ) unless ( -e $self -> {'directory'} );
 582        }
 583 end _make_dir
 584
 585 # }}} _make_dir
 586
 587 # {{{ run
 588
 589 # {{{ documentation
 590 # results structure:
 591
 592 # {results}
 593 #      |
 594 #      |->[0]                                First model
 595 #      |   |
 596 #      |   |->{own}                          The results from this tool on the first model
 597 #      |   |    |
 598 #      |   |    |->[0]
 599 #      |   |    |   |
 600 #      |   |    |   |->{name}                    e.g. 'parameter.estimates'
 601 #      |   |    |   |
 602 #      |   |    |   |->{labels}
 603 #      |   |    |   |     |
 604 #      |   |    |   |     |->[0]...              e.g. ['TH1', 'TH2', 'TH3'] indexed on problem and sub problem
 605 #      |   |    |   |     |->[1]
 606 #      |   |    |   |     |...
 607 #      |   |    |   |     |->[#problems]
 608 #      |   |    |   |
 609 #      |   |    |   |->{values}
 610 #      |   |    |         |
 611 #      |   |    |         |->[0]                 e.g. [0.21, 20.3, 3] indexed as above
 612 #      |   |    |         |->[1]
 613 #      |   |    |         |...
 614 #      |   |    |         |->[#problems]
 615 #      |   |    |
 616 #      |   |    |->[1]
 617 #      |   |    |   |
 618 #      |   |    |   |->{name}                    e.g. 'standard.errors'
 619 #      |   |    |   |->{labels}
 620 #      |   |    |   |->{values}
 621 #      |   |->{subtools}                   The results from the subtools on the first model
 622 #      |           |
 623 #      |           |->[0]                    First sub tool
 624 #      |           |   |
 625 #      |           |   |->[0]                First model of the prepared models sent to the first sub tool
 626 #      |           |   |   |
 627 #      |           |   |   |->{own}          The first sub tools results on the first model
 628 #      |           |   |   |    |
 629 #      |           |   |   |    |->[0]       First result type
 630 #      |           |   |   |    |   |
 631 #      |           |   |   |    |   |->{name}
 632 #      |           |   |   |    |   |->{labels}
 633 #      |           |   |   |    |   |->{values}
 634 #      |           |   |   |    |
 635 #      |           |   |   |    |->[1]       Second result type
 636 #      |           |   |   |    |   |
 637 #      |           |   |   |    |   |->{name}
 638 #      |           |   |   |    |   |->{labels}
 639 #      |           |   |   |    |   |->{values}
 640 #      |           |   |   |->{subtools}   Another tool level
 641 #      |           |   |   |      ...
 642 #      |           |   |->[1]                Second model of the prepared models sent to the first sub tool
 643 #      |           |   |   |
 644 #      |           |   |   |->{own}          The first sub tools results on the second model
 645 #      |           |   |   |    |
 646 #      |           |   |   |    |->[0]       First result type
 647 #      |           |   |   |    |   |
 648 #      |           |   |   |    |   |->{name}
 649 #      |           |   |   |    |   |->{labels}
 650 #      |           |   |   |    |   |->{values}
 651 #      |           |   |   |    |
 652 #      |           |   |   |    |->[1]       Second result type
 653 #      |           |   |   |    |   |
 654 #      |           |   |   |    |   |->{name}
 655 #      |           |   |   |    |   |->{labels}
 656 #      |           |   |   |    |   |->{values}
 657 #      |           |   |   |->{subtools}   Another tool level
 658 #      |           |   |   |      ...
 659 #      |           |   |   |...
 660 #      |           |   |->[#prepared models] Last model of the prepared models sent to the first sub tool
 661 #      |           |   |   |
 662 #      |           |   |   |->{own}          The first sub tools results on the last model
 663 #      |           |   |   |    |
 664 #      |           |   |   |    |->[0]       First result type
 665 #      |           |   |   |    |   |
 666 #      |           |   |   |    |   |->{name}
 667 #      |           |   |   |    |   |->{labels}
 668 #      |           |   |   |    |   |->{values}
 669 #      |           |   |   |    |
 670 #      |           |   |   |    |->[1]       Second result type
 671 #      |           |   |   |    |   |
 672 #      |           |   |   |    |   |->{name}
 673 #      |           |   |   |    |   |->{labels}
 674 #      |           |   |   |    |   |->{values}
 675 #      |           |   |   |->{subtools}   Another tool level
 676 #      |           |   |   |      ...
 677 #      |           |->[1]                    Second sub tool
 678 #      |           |...
 679 #      |           |->[#tools]             Last sub tool
 680 #      |
 681 #      |->[1]                                Second model. All above repeated for this model.
 682 #      |...
 683 #      |->[#models]                          Last model. As above.
 684
 685 # Prepared_models structure:
 686
 687 # {prepared_models}
 688 #      |
 689 #      |->[0]                                First model
 690 #      |   |
 691 #      |   |->{own}                          The prepared models of this tool using the first model as base
 692 #      |   |    |
 693 #      |   |    |->[0]                       First prep model
 694 #      |   |    |->[1]                       Second prep model
 695 #      |   |    |...
 696 #      |   |    |->[#prep_models]            Last prep model
 697 #      |   |
 698 #      |   |->{subtools}                   The prepared models of the subtools on the first model. Only one sub tool per prepared model above.
 699 #      |           |
 700 #      |           |->[0]                    First model of the models (prepared above) sent to the first sub tool
 701 #      |           |   |
 702 #      |           |   |->{own}              The first sub tools prepared models on its first model
 703 #      |           |   |    |
 704 #      |           |   |    |->[0]           First prep model
 705 #      |           |   |    |->[1]           Second prep model
 706 #      |           |   |    |...
 707 #      |           |   |    |->[#prep_models]Last prep model
 708 #      |           |   |
 709 #      |           |   |->{subtools}
 710 #      |           |
 711 #      |           |->[1]                    Second model of the models (prepared above) sent to the first sub tool
 712 #      |           |   |
 713 #      |           |   |->{own}              The first sub tools prepared models on its second model
 714 #      |           |   |    |
 715 #      |           |   |    |->[0]           First prep model
 716 #      |           |   |    |->[1]           Second prep model
 717 #      |           |   |    |...
 718 #      |           |   |    |->[#prep_models]Last prep model
 719 #      |           |   |
 720 #      |           |   |->{subtools}
 721 #      |           |
 722
 723 # }}}
 724
 725 start run
 726     {
 727         my $return_dir = getcwd();
 728         chdir( $self -> {'directory'} );
 729
 730         $self -> pre_fork_setup;
 731
 732         my @models = @{$self -> {'models'}};
 733         # Use the thread number of this tool level:
 734         my $threads = ref( $self -> {'threads'} ) eq 'ARRAY' ?
 735             $self -> {'threads'} -> [0] : $self -> {'threads'};
 736
 737         # No point in using more threads than models
 738         $threads = $#models + 1 if ( $threads > $#models + 1);
 739
 740         # Currently parallel execution is not supported on windows platforms
 741         $threads = 1 if( $Config{osname} eq 'MSWin32' );
 742
 743         # Create new forkmanager
 744         my $pm = ext::Parallel::ForkManager -> new($threads) if ( $threads > 1 );
 745         my $aborting = 0;
 746         $pm -> run_on_finish( sub { my ( $pid, $exit_code, $ident ) = @_;
 747                                     if( $exit_code ){
 748                                       debug -> die( message => "Subtool died, exiting." );
 749                                     }
 750                                   } ) if ( $threads > 1 );
 751
 752         # Store some globals for single-thread mode to make each loop
 753         # over the models see the same (fresh) prepared attributes as
 754         # in the parallel mode.
 755         my @pre_fork_tools;
 756
 757         # THREAD if ( $threads == 1 ) {
 758         # THREAD    if ( defined $self -> {'tools'} ) {
 759         # THREAD        @pre_fork_tools = @{$self -> {'tools'}};
 760         # THREAD    }
 761         # THREAD }
 762
 763         # Loop over the models
 764         for ( my $i = 1; $i <= scalar @models; $i++ ) {
 765             # Spawn new processes
 766             $pm -> start and next if ( $threads > 1 );
 767
 768             # model_number is a member that tells the tool which model
 769             # it is currently working on.
 770             $self -> model_number( $i );
 771
 772             # Reset some globals: (only needed for threads==1)
 773             # THREAD if ( $threads == 1 && defined $self -> {'tools'}) {
 774             # THREAD    @{$self -> {'tools'}} = @pre_fork_tools;
 775             # THREAD }
 776
 777             # Make sure that each process gets a unique random sequence:
 778             random_set_seed_from_phrase(random_uniform_integer(1,0,10000*$i));
 779 #           srand(rand()*10000*$i);
 780
 781             # First, run setup
 782             $self -> setup( model_number => $i );
 783
 784             # Run the subtools
 785             my @tool_results = ();
 786             my @tool_models = ();
 787             if ( defined $self -> {'tools'} ) {
 788                 foreach my $tool (@{$self -> {'tools'}}){
 789                     # There is to date (2004-01-27 no tool that creates more than one internal
 790                     # tool. Hence this is a loop of one cycle. But to be general, again...
 791                     # Run the tool:
 792                     my( $returns, $prep_models ) = $tool -> run;
 793                     # push the sub tool's return values
 794                     push ( @tool_results, $returns );
 795                     if ( defined $prep_models ) {
 796                         push ( @tool_models, $prep_models );
 797                     } else {
 798                       'debug' -> warn(level => 1,
 799                                       message => "inside " . ref($self) . " but no prep_models defined from $tool $i");
 800                     }
 801                     $self -> post_subtool_analyze;
 802                 }
 803
 804             } else {
 805                 debug -> die( message => "No tool object to run from tool object." );
 806             }
 807
 808             $self -> {'results'}[$i-1]{'subtools'}= \@tool_results;
 809             $self -> {'prepared_models'}[$i-1]{'subtools'} = \@tool_models;
 810
 811             # Analyze the results
 812             $self -> analyze( model_number => $i );
 813
 814             Storable::store( $self -> {'prepared_models'},
 815                              $self -> {'directory'}."/m$i/prepared_models.log" );
 816             if ( $threads > 1 ) {
 817                 Storable::store( $self -> {'results'},
 818                                  $self -> {'directory'}."/m$i/results.log" );
 819                   # Maybe redundant to transfer back both prepared_models as well as tools
 820
 821                   # Actually, by principle everything interesting for
 822                   # a parent should be placed in "results" or possibly
 823                   # "prepared_models".
 824
 825                   #Storable::store( $self -> {'tools'},
 826                         #          $self -> {'directory'}."/m$i/tools.log" );
 827                 }
 828             $pm -> finish if ( $threads > 1 );
 829         }
 830         $pm -> wait_all_children if ( $threads > 1 );
 831
 832         for( my $i = 1; $i <= scalar @{$self -> {'models'}}; $i++ ) {
 833           my @prepared_models = @{Storable::retrieve( $self -> {'directory'}.
 834                                                       "/m$i/prepared_models.log" )};
 835           unlink( $self -> {'directory'} . "/m$i/prepared_models.log" );
 836           $self->{'prepared_models'}[$i-1] = $prepared_models[$i-1];
 837         }
 838
 839         if ( $threads > 1 ) {
 840             for( my $i = 1; $i <= scalar @{$self -> {'models'}}; $i++ ) {
 841                 my @model_results = @{Storable::retrieve( $self -> {'directory'}.
 842                                                               "/m$i/results.log" )};
 843 # It is important to keep the number of dimensions: push the first value, not the
 844 # whole array!
 845                 $self->{'results'}[$i-1] = $model_results[$i-1];
 846
 847                 # Read comment aboud tools.log near storable above.
 848
 849                 #push( @{$self -> {'tools'}},
 850                 #      Storable::retrieve( $self -> {'directory'}.
 851                 #                         "/m$i/tools.log" ) );
 852             }
 853           }
 854
 855
 856         # Perform analyses that need to be done after all models have
 857         # been run and processed. Also write a result file if one is
 858         # defined.
 859         $self -> post_fork_analyze;
 860
 861         chdir($return_dir);
 862 #       @results     = @{$self -> {'results'}};
 863 #       @prepared_models = @{$self -> {'prepared_models'}};
 864       }
 865 end run
 866
 867 # }}} run
 868
 869 # {{{ _prepare_model
 870
 871 start _prepare_model
 872       {
 873
 874           my ($newdir, $newfile) = OSspecific::absolute_path( $self -> {'directory'} .  '/m'.$model_number, '' );
 875           debug -> warn( level   => 2,
 876                          message => "Making directory\t\t" . $newdir );
 877           mkdir( $newdir );
 878       }
 879 end _prepare_model
 880
 881 # }}} _prepare_model
 882
 883 # {{{ analyze
 884
 885 start analyze
 886       {
 887         $self -> {'raw_results'}[$model_number-1] =
 888           $self -> {'tools'} -> [0] -> raw_results;
 889         my $sub_analyze = $self -> {'subtools'} -> [0];
 890         if ( defined $sub_analyze ) {
 891           $sub_analyze = $sub_analyze.'_analyze';
 892           if( defined $self -> can( $sub_analyze ) ){
 893             $self -> $sub_analyze( model_number => $model_number );
 894           }
 895         }
 896       }
 897 end analyze
 898
 899 # }}} analyze
 900
 901 # {{{ _modelfit_raw_results_callback
 902 start _modelfit_raw_results_callback
 903       {
 904         # Use the scm's raw_results file.
 905         my ($dir,$file) =
 906           OSspecific::absolute_path( $self -> {'directory'},
 907                                      $self -> {'raw_results_file'}[$model_number-1] );
 908         $subroutine = sub {
 909           my $modelfit = shift;
 910           $modelfit -> raw_results_file( $dir.$file );
 911         };
 912         return $subroutine;
 913       }
 914 end _modelfit_raw_results_callback
 915 # }}} _modelfit_raw_results_callback
 916
 917 # {{{ read_raw_results
 918 start read_raw_results
 919       {
 920         for ( my $i = 1; $i <= scalar @{$self->{'models'}}; $i++ ) { # All models
 921           if ( -e $self -> {'directory'}.'raw_results'.$i.'.csv' ) {
 922             undef $self -> {'raw_results_header'};
 923             open( RRES, $self -> {'directory'}.'raw_results'.$i.'.csv' );
 924             my @file = <RRES>;
 925             close( RRES );
 926             map { chomp; my @tmp = split(',',$_); $_ = \@tmp } @file ;
 927             $self -> {'raw_results_header'} -> [$i-1] = shift @file;
 928             $self -> {'raw_results'} -> [$i-1] = \@file;
 929           }
 930         }
 931       }
 932 end read_raw_results
 933 # }}} read_raw_results
 934
 935
 936 # {{{ post_subtool_analyze
 937
 938 start post_subtool_analyze
 939     {
 940         my $sub_analyze = $self -> {'subtools'} -> [0];
 941         if ( defined $sub_analyze ) {
 942             $sub_analyze = $sub_analyze.'_post_subtool_analyze';
 943             if( defined $self -> can( $sub_analyze ) ){
 944                 $self -> $sub_analyze( model_number => $model_number );
 945             }
 946         }
 947     }
 948 end post_subtool_analyze
 949
 950 # }}} analyze
 951
 952 # {{{ results
 953
 954 # start results
 955 #       {
 956 #         # Run the results specific for the subtool
 957 #         my $sub_results = $self -> {'subtools'} -> [0];
 958 #         if ( defined $sub_results ) {
 959 #             $sub_results = $sub_results.'_results';
 960 #             @results = @{ $self -> $sub_results( accessor => $accessor, format => $format ) };
 961 #         }
 962 #       }
 963 # end results
 964
 965 # }}} results
 966
 967 start harvest_output
 968     {
 969
 970       # harvest_output is a complement to AUTOLOAD below. AUTOLOAD is
 971       # currently used to find the AUTOLOAD:ed accessor in any
 972       # existing subtool, model, data or outputobject. It is
 973       # inefficient in that it will have to be called for once for
 974       # each accessor. harvest_output will take a list of accessors
 975       # that it will search for in each object, saving time and
 976       # foremost; memory. Also it will take arguments such as
 977       # "search_models", "search_subtools" that will make things more
 978       # efficient if you know where to search.
 979
 980       unless( $search_models + $search_output + $search_data == 1 ){
 981         'debug' -> die( message => "This is a PsN bug: Only one of the 'search_' options can and must be specified." );
 982       }
 983
 984       if ( $search_subtools ) {
 985         print "\n\nSearching subtools, which is a very untested functionality!!\n\n";
 986
 987 #       if ( defined $self -> {'tools'} ) {
 988 #         my @tools = @{$self -> {'tools'}};
 989 #         foreach my $tool_ref ( @tools ) {
 990 #           foreach my $tool ( @{$tool_ref} ) {
 991 #             if ( $tool -> can( $accessor ) ) {
 992 #               push( @result, $tool -> $accessor( %accessor_parameters ) );
 993 #             } else {
 994 #               'debug' -> die(message => "Accessor $accessor is not available in the tool " . ref($tool) );
 995 #             }
 996 #           }
 997 #         }
 998 #       } else {
 999 #         'debug' -> warn( level => 1,
1000 #                          message => "Supposed to be run by the sub tools but no sub tools were defined" );
1001 #       }
1002
1003       } else {
1004
1005         sub models_traverse {
1006           my %parameters = @_;
1007           my @models = $parameters{'models'} ? @{$parameters{'models'}} : ();
1008           my $search_models = $parameters{'search_models'};
1009           my $search_output = $parameters{'search_output'};
1010           my $search_data   = $parameters{'search_data'};
1011           my $accessor_parameters = $parameters{'accessor_parameters'};
1012           my $accessors = $parameters{'accessors'};
1013           my %results;
1014           for( my $i = 0; $i < scalar (@models); $i++ ){
1015
1016             foreach my $model ( @{$models[$i]{'own'}} ) {
1017
1018               foreach my $accessor( @{$accessors} ) {
1019
1020                 if( $search_models and $model -> can( $accessor ) ) {
1021                   push( @{$results{$accessor}[$i]{'own'}}, $model -> $accessor( %{$accessor_parameters} ) );
1022
1023                 } elsif( $search_data and $model -> datas -> [0] -> can( $accessor ) ) {
1024                   push( @{$results{$accessor}[$i]{'own'}}, $model -> datas -> [0] -> $accessor( %{$accessor_parameters} ) );
1025
1026                 } elsif( $search_output and $model -> outputs -> [0] -> can( $accessor ) ) {
1027                   push( @{$results{$accessor}[$i]{'own'}}, $model -> outputs -> [0] -> $accessor( %{$accessor_parameters} ) );
1028
1029                 } else {
1030                   'debug' -> die( message => "Neither model, data, output have a method for $accessor" );
1031                 }
1032
1033                 if ( defined $models[$i]{'subtools'} ) {
1034                   push( @{$results{$accessor}[$i]{'subtools'}}, models_traverse( models => $models[$i]{'subtools'} ) );
1035                 }
1036               }
1037
1038               if( $search_data ){
1039                 $model -> datas -> [0] -> flush();
1040               }
1041               if( $search_output ){
1042                 $model -> outputs -> [0] -> flush();
1043               }
1044             }
1045
1046           }
1047           return \%results;
1048         }
1049       }
1050
1051       my @models;
1052
1053       if ( $search_original_models ) {
1054         @models = @{$self -> {'models'}};
1055       } elsif ( defined $self -> {'prepared_models'} ) {
1056         @models = @{$self -> {'prepared_models'}};
1057       } else {
1058         'debug' -> warn( level => 2,
1059                          message => "No prepared models available" );
1060         return {};
1061       }
1062
1063       %result = %{models_traverse( models => \@models,
1064                                    search_models => $search_models,
1065                                    search_output => $search_output,
1066                                    search_data => $search_data,
1067                                    accessor_parameters => \%accessor_parameters,
1068                                    accessors => \@accessors )};
1069
1070     }
1071 end harvest_output
1072 # {{{ AUTOLOAD
1073
1074 start AUTOLOAD
1075       {
1076         debug -> warn( level => 2,
1077                        message => "Caught method $AUTOLOAD" );
1078         debug -> warn( level => 2,
1079                        message => "arguments: @_" );;
1080         my %parm = @_;
1081         my $original_models = $parm{'original_models'};
1082         delete( $parm{'original_models'} );
1083         my $class = $parm{'class'};
1084         $AUTOLOAD =~ s/.*://;
1085         return if $AUTOLOAD eq 'DESTROY';
1086
1087 # TODO: Kolla att orginalmodellen körs med submetod i run!!!!! kolla också var resultaten
1088 # läggs!!!
1089
1090         if ( $class =~ /tool::/ ) {
1091           delete( $parm{'mod_array'} );
1092           delete( $parm{'original_models'} );
1093           delete( $parm{'class'} );
1094           @_ = %parm;
1095           if ( defined $self -> {'tools'} ) {
1096             my @tools = @{$self -> {'tools'}};
1097             my $accessor = $AUTOLOAD;
1098             foreach my $tool_ref ( @tools ) {
1099               foreach my $tool ( @{$tool_ref} ) {
1100                 if ( $tool -> can( $accessor ) ) {
1101                   push( @result, $tool -> $accessor( @_ ) );
1102                 } else {
1103                   'debug' -> die(message => "Accessor $accessor is not available in the tool " . ref($tool) );
1104                 }
1105               }
1106             }
1107           } else {
1108             print "AUTOLOAD in ",ref($self)," caught tool $AUTOLOAD. It was ",
1109               "supposed to be run by the sub tools but no sub tools were defined\n";
1110           }
1111         } else {
1112           my @models;
1113           my @prep_models;
1114           if ( $original_models ) {
1115             @models = @{$self -> {'models'}};
1116           } elsif ( defined $self -> {'prepared_models'} ) {
1117             'debug' -> warn(level => 1,
1118                             message => "Using prepared models" );
1119             @prep_models = @{$self -> {'prepared_models'}};
1120           } else {
1121             print "WARNING: tool -> AUTOLOAD: no prepared models available\n";
1122           }
1123
1124           sub models_traverse {
1125             my %parm  = @_;
1126             my $mod_array_ref = $parm{'mod_array'};
1127             my $class     = $parm{'class'};
1128             delete( $parm{'mod_array'} );
1129             delete( $parm{'class'} );
1130             @_ = %parm;
1131             my @mod_array;
1132             @mod_array = defined $mod_array_ref ? @{$mod_array_ref} : ();
1133             my @inner_result = ();
1134             #             my $i = 0;
1135             for ( my $i = 0; $i <= $#mod_array; $i++ ) {
1136               foreach my $model ( @{$mod_array[$i]{'own'}} ) {
1137                 unless ( defined $class ) {
1138                   my $mod_can = defined $model -> can( $AUTOLOAD ) ? 1 : 0;
1139                   my $out_can = (defined $model -> outputs and
1140                                  defined $model -> outputs -> [0] and
1141                                  defined $model -> outputs -> [0] -> can($AUTOLOAD))
1142                     ? 1 : 0;
1143                   my $dat_can = (defined $model -> datas and
1144                                  defined $model -> datas -> [0] and
1145                                  defined $model -> datas -> [0] -> can($AUTOLOAD))
1146                     ? 1 : 0;
1147                   if ( ($mod_can + $out_can + $dat_can) > 1 ) {
1148                     my $classes;
1149                     $classes = 'model ' if $mod_can;
1150                     $classes = $classes.'output ' if $out_can;
1151                     $classes = $classes.'data ' if $dat_can;
1152                     'debug' -> die( message => "Accessor $AUTOLOAD available in multiple classes: $classes" );
1153                   }
1154                   if ( $mod_can + $out_can + $dat_can == 0 ) {
1155                     'debug' -> die( message => "Accessor $AUTOLOAD is not available in any of the model, ".
1156                                     "output or data classes OR no output or data object available".
1157                                     " through this model" );
1158                   }
1159                   if ( $mod_can ) {
1160                     push( @{$inner_result[$i]{'own'}}, $model -> $AUTOLOAD( @_ ) );
1161                   } elsif ( $out_can ) {
1162                     push( @{$inner_result[$i]{'own'}}, $model -> outputs -> [0] -> $AUTOLOAD( @_ ) );
1163                   } elsif ( $dat_can ) {
1164                     push( @{$inner_result[$i]{'own'}}, $model -> datas -> [0] -> $AUTOLOAD( @_ ) );
1165                   }
1166                 } else {
1167                   if ( $class eq 'model' ) {
1168                     push( @{$inner_result[$i]{'own'}}, $model -> $AUTOLOAD( @_ ) );
1169                   } else {
1170                     my $class_accessor = $class.'s';
1171                     push( @{$inner_result[$i]{'own'}}, $model -> $class_accessor -> [0] -> $AUTOLOAD( @_ ) );
1172                   }
1173                 }
1174               }
1175               #               $i++;
1176               if ( defined $mod_array[$i]{'subtools'} ) {
1177                 push( @{$inner_result[$i]{'subtools'}},
1178                       models_traverse( mod_array => $mod_array[$i]{'subtools'},
1179                                        class     => $class,
1180                                        %parm ) );
1181               }
1182             }
1183             return \@inner_result;
1184           }
1185           if ( $original_models ) {
1186             debug -> warn( level => 2,
1187                            message => "Traversing ".scalar $models[0]{'own'}." model(s)" );
1188             @result = @{models_traverse( mod_array => \@models,
1189                                          %parm )};
1190           } else {
1191             @result = @{models_traverse( mod_array => \@prep_models,
1192                                          %parm )};
1193           }
1194         }
1195       }
1196 end AUTOLOAD
1197
1198 # }}} AUTOLOAD
1199
1200 # {{{ process_results
1201
1202 # sub process_results {
1203 #   my $res_ref = shift;
1204 #   my $pad     = shift;
1205 #   $pad++;
1206 #   foreach my $res ( @{$res_ref} ) {
1207 #     if ( ref ( $res ) eq 'ARRAY' ) {
1208 #       process_results( $res, $pad );
1209 #     } else {
1210 #       print "HEPP ",ref($self)," $i $pad $res\n";
1211 #     }
1212 #   }
1213 # }
1214
1215 # }}}