bin/unwrap_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 strict;
  12
  13 use Getopt::Long;
  14 use vars qw/ $opt_help
  15              $opt_h
  16              $opt_cont_column
  17              $opt_new_name
  18              $opt_debug
  19              $opt_debug_package
  20              $opt_debug_subroutine /;
  21
  22 ## Configure the command line parsing
  23 Getopt::Long::config("auto_abbrev");
  24
  25 ## Declare the options
  26 my $res = GetOptions("help",                 # Display help message
  27                      "h|?",
  28                      "cont_column:i",
  29                      "new_name:s",
  30                      "directory:s",
  31                      "debug:0",
  32                      "debug_package:s",
  33                      "debug_subroutine:s" );
  34
  35 exit unless $res;
  36
  37 if($opt_help or $opt_h) {
  38   print <<'ENDHELP';
  39
  40   unwrap_data
  41
  42       Unwrap_data is a perl script that unwraps a data file coded with
  43       the CONT data item for split rows. The only restriction is that
  44       the subject identifier (ID) must be in column one.
  45
  46     Usage:
  47
  48       unwrap_data filename
  49       [-cont_column=column_number]
  50       [-new_name=new_filename]
  51
  52     Example:
  53
  54       ./unwrap_data -idc=1 -new=new_wrapped.dta old_big.dta
  55
  56     Options:
  57
  58       -cont_column
  59         The column number of the CONT data itemn.
  60
  61       -new_name
  62         The name of the new data set. If no name is given, the result
  63         is printed on standard output.
  64
  65 ENDHELP
  66
  67   exit;
  68 }
  69
  70 ## Check that we do have a model file
  71 if ( scalar(@ARGV) < 1 ) {
  72   print "A data file must be specified. Use 'unwrap_data -h' for help.\n";
  73   exit;
  74 }
  75
  76 ui -> category( 'data' );
  77
  78 debug -> level( $opt_debug );
  79 debug -> package( $opt_debug_package );
  80 debug -> subroutine( $opt_debug_subroutine );
  81
  82 my $data = data -> new ( filename    => $ARGV[0],
  83                          idcolumn    => 1,
  84                          cont_column => $opt_cont_column );
  85
  86
  87 if ( defined $opt_new_name ) {
  88   open( NEW, ">$opt_new_name" );
  89   my ($data_ref, $prim_ref, $sec_ref ) = $data ->
  90       format_data( wrap        => 0 );
  91   print NEW @{$data_ref};
  92   close( NEW );
  93 } else {
  94   my ($data_ref, $prim_ref, $sec_ref ) = $data ->
  95     format_data( wrap        => 0 );
  96   print @{$data_ref}
  97 }
  98