bin/create_cont_data

   1 #!/usr/local/bin/perl
   2
   3 use FindBin qw($Bin);
   4 use lib "$Bin/../lib";
   5
   6 # Don't edit the line below, it must look exactly like this.
   7 # Everything above this line will be replaced #
   8
   9 use PsN;
  10 use data;
  11 use model;
  12 use strict;
  13 use Data::Dumper;
  14
  15 use Getopt::Long;
  16 use vars qw/ $opt_help
  17              $opt_h
  18              $opt_idcolumn
  19              $opt_cont_column
  20              $opt_wrap_column
  21              $opt_model
  22              $opt_new_name
  23              $opt_debug
  24              $opt_debug_package
  25              $opt_debug_subroutine /;
  26
  27 ## Configure the command line parsing
  28 Getopt::Long::config("auto_abbrev");
  29
  30 ## Declare the options
  31 my $res = GetOptions("help",                 # Display help message
  32                      "h|?",
  33                      "idcolumn:i",
  34                      "cont_column:i",
  35                      "wrap_column:i",
  36                      "model:s",
  37                      "new_name:s",
  38                      "directory:s",
  39                      "debug:0",
  40                      "debug_package:s",
  41                      "debug_subroutine:s" );
  42
  43 exit unless $res;
  44
  45 if($opt_help or $opt_h) {
  46   print <<'ENDHELP';
  47
  48   create_cont_data
  49
  50       Create_cont_data is a perl script that wraps the rows in a data
  51       set with more than 20 columns. Rows that do not end up at
  52       exactly 20 will be padded with dummy columns.
  53
  54     Usage:
  55
  56       create_cont_data filename
  57       [-idcolumn=column_number]
  58       [-cont_column=column_number]
  59       [-wrap_column=column_number]
  60       [-model=filename]
  61       [-new_name=new_filename]
  62
  63     Example:
  64
  65       ./create_cont_data -idc=1 -new=new_wrapped.dta old_big.dta
  66
  67       ./create_cont_data -idc=1 -new=new_wrapped.dta -mod=run.mod old_big.dta
  68
  69     Options:
  70
  71       -idcolumn
  72         The number of the column holding the subject identifier. The
  73         default value is 1.
  74
  75       -cont_column
  76         The number of the column where the CONT data itemn should be
  77         placed. The default is to put it as the last item in each row.
  78
  79       -wrap_column
  80         The number of the columns in each row. The default is 20.
  81
  82       -model
  83         The name of a model file. The header as specified in the
  84         $INPUT record is used as template for the order and format of
  85         the new data file.
  86
  87       -new_name
  88         The name of the new data set. If no name is given, the result
  89         is printed on standard output.
  90
  91 ENDHELP
  92
  93   exit;
  94 }
  95
  96 ## Check that we do have a model file
  97 if ( scalar(@ARGV) < 1 ) {
  98   print "A data file must be specified. Use 'create_cont_data -h' for help.\n";
  99   exit;
 100 }
 101
 102 ui -> category( 'data' );
 103
 104 debug -> level( $opt_debug );
 105 debug -> package( $opt_debug_package );
 106 debug -> subroutine( $opt_debug_subroutine );
 107
 108 my ( $mod, @model_header );
 109 if ( defined $opt_model ) {
 110   $mod = model -> new ( filename => $opt_model );
 111   @model_header = @{$mod -> problems -> [0] -> header};
 112 }
 113
 114 my $data = data -> new ( filename     => $ARGV[0],
 115                          model_header => \@model_header,
 116                          idcolumn     => $opt_idcolumn );
 117
 118 if ( defined $opt_new_name ) {
 119   open( NEW, ">$opt_new_name" );
 120   my ($data_ref, $prim_ref, $sec_ref ) = $data ->
 121       format_data( wrap         => 1,
 122                    cont_column  => $opt_cont_column,
 123                    wrap_column  => $opt_wrap_column );
 124   print NEW @{$data_ref};
 125   close( NEW );
 126 } else {
 127   my ($data_ref, $prim_ref, $sec_ref ) = $data ->
 128     format_data( wrap         => 1,
 129                  cont_column  => $opt_cont_column,
 130                  wrap_column  => $opt_wrap_column );
 131   print @{$data_ref}
 132 }
 133