functionalized version 2, implemented version 1 using functions in version 2
[PsN.git] / bin / unwrap_data
blob43cb44a6d80c9c6850f6354b18accd8bec9788b0
1 #!/usr/local/bin/perl
3 use FindBin qw($Bin);
4 use lib "$Bin/../lib";
6 # Don't edit the line below, it must look exactly like this.
7 # Everything above this line will be replaced #
9 use PsN;
10 use data;
11 use strict;
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 /;
22 ## Configure the command line parsing
23 Getopt::Long::config("auto_abbrev");
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" );
35 exit unless $res;
37 if($opt_help or $opt_h) {
38 print <<'ENDHELP';
40 unwrap_data
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.
46 Usage:
48 unwrap_data filename
49 [-cont_column=column_number]
50 [-new_name=new_filename]
52 Example:
54 ./unwrap_data -idc=1 -new=new_wrapped.dta old_big.dta
56 Options:
58 -cont_column
59 The column number of the CONT data itemn.
61 -new_name
62 The name of the new data set. If no name is given, the result
63 is printed on standard output.
65 ENDHELP
67 exit;
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;
76 ui -> category( 'data' );
78 debug -> level( $opt_debug );
79 debug -> package( $opt_debug_package );
80 debug -> subroutine( $opt_debug_subroutine );
82 my $data = data -> new ( filename => $ARGV[0],
83 idcolumn => 1,
84 cont_column => $opt_cont_column );
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}