1#!/usr/bin/perl -w -i.bak - # -*- perl -*- 2 3use strict; 4my $ME = $0; $ME =~ s{.*/}{}; #-- program name minus leading path if any 5 6my $USAGE =<<USAGE; 7Usage: $ME [options] hip*.dat 8Options: 9 -c --clean Delete backup files. 10 -e --edit Actually change the specified files. 11 -f --force Apply changes despite warnings. 12 -h --help Show this usage message. 13 -p --pretend Just show changes that would be made. 14 -r --reverse Convert files in the new format back to the old. 15 -u --undo Undoes changes by moving backup files back to originals. 16 -v --verbose Show filenames in pretend mode. 17 18Converts the format of hipXXX.dat files so that the fixed length gname 19comes before the variable length name. 20 21old format: [name[: gname]] | [: gname] 22new format: [; gname[; name]] 23 24DANGER: This program edits files in place. Always use --pretend first. 25USAGE 26 27@ARGV or die $USAGE; 28 29my ($REVERSE, $PRETEND, $VERBOSE, $UNDO, $CLEAN, $FORCE, $ABORT, $EDIT); 30my $BAK = ".bak"; 31my $SEP = ','; 32my $GNAME_LEN = 7; 33 34while (@ARGV and $ARGV[0] =~ s/^-//) { 35 my $arg = shift @ARGV; 36 if ($arg =~ /^(r|-reverse)$/) { $REVERSE = 1 } 37 elsif ($arg =~ /^(p|-pretend)$/) { $PRETEND = 1 } 38 elsif ($arg =~ /^(v|-verbose)$/) { $VERBOSE = 1 } 39 elsif ($arg =~ /^(u|-undo)$/ ) { $UNDO = 1 } 40 elsif ($arg =~ /^(c|-clean)$/ ) { $CLEAN = 1 } 41 elsif ($arg =~ /^(f|-force)$/ ) { $FORCE = 1 } 42 elsif ($arg =~ /^(e|-edit)$/ ) { $EDIT = 1 } 43 elsif ($arg =~ /^(h|-help$)/ ) { die $USAGE } 44 elsif ($arg =~ /^$/ ) { last } 45 else { die qq(ERROR: Unrecognized argument: "-$arg":\n$USAGE); } 46} 47 48@ARGV or 49 die "$ME Error: need to specify at least one hipXXX.dat file\n"; 50 51$CLEAN and $UNDO and 52 die "$ME Error: can't --clean and --undo at the same time.\n"; 53 54$EDIT and $UNDO and 55 die "$ME Error: can't --edit and --undo at the same time.\n"; 56 57my @files = @ARGV; 58 59#--- Remove backup files 60if ($CLEAN and not $EDIT) { 61 clean(@files); 62} 63#--- Copy backups back over 'originals' 64elsif ($UNDO) { 65 for my $file (@files) { 66 my $backup = $file . $BAK; 67 -e $backup or do { 68 warn "$ME Warning: backup file '$backup' for '$file' does not exist\n"; 69 next; 70 }; 71 if ($PRETEND) { 72 print "$ME would rename: $backup => $file\n"; 73 next; 74 } 75 rename( $backup, $file) or 76 warn "$ME Warning: unable to undo changes to '$file': $!\n"; 77 } 78} 79 80#--- Show all lines that would be changed 81elsif ($PRETEND) { 82 for my $file (@files) { 83 open(FILE, $file) or do { 84 warn "$ME Warning: could not open($file) $!\n"; 85 next; 86 }; 87 my $fname = $VERBOSE ? "$file:" : ""; 88 while (<FILE>) { 89 my $new = swap_names($_, $REVERSE); 90 $new eq $_ and next; 91 print "$fname-$_"; 92 print "$fname+$new"; 93 } 94 close FILE or die "$ME Warning: could not close($file) $!\n"; 95 } 96} 97 98#--- Edit all @ARGV files in-place via Perl -i flag in line 1. 99elsif ($EDIT) { 100 while (<>) { 101 print swap_names($_, $REVERSE); 102 } 103} 104 105else { 106 die "$ME: Must specify a command: --edit --clean --undo --pretend\n"; 107} 108 109$EDIT and $CLEAN and clean(@files); 110 111exit; 112 113#=== End of Main code ====================================================== 114 115sub clean { 116 for my $file (@_) { 117 my $backup = $file . $BAK; 118 -e $backup or do { 119 warn "$ME Warning: backup file '$backup' for '$file' does not exist\n"; 120 next; 121 }; 122 if ($PRETEND) { 123 print "$ME would remove: $backup\n"; 124 next; 125 } 126 unlink($backup) or 127 warn "$ME Warning: unable to delete '$backup': $!\n"; 128 } 129} 130 131#---- swap_names($line, $reverse_flag) ------------------------------------- 132# Change the format of name and gname at the end of the line if it matches 133# the format of the hipXXX.dat data files. Return the line unchanged if 134# it starts with "#" or if it is too short. Aborts if a data line does not 135# match the format of hipXXX.dat files. 136 137sub swap_names { 138 my ($line, $reverse) = @_; 139 return $line if $ABORT; 140 $line =~ m/^#/ and return $line; 141 my $d1 = substr($line, 0, 72, ''); 142 my $tail = $/ x chomp($line); # $tail contains chomped char(s) 143 length($line) > 0 or return $d1 . $tail; 144 145 #-- extreme check of format of a data line 146 $FORCE or $d1 =~ m{^(\d{6}\.\d\d)\s # RA HHMMSS.SS 147 ([+-]\d{6}\.\d)\s # DEC DDMMSS.SS 148 ([+-]\d{6}\.\d) # dRA/dt 149 ([+-]\d{6}\.\d) # dDec/dt 150 (\d{5}\.\d)\s # Parallax 151 ([\d-]\d\.\d\d) # Magnitude 152 ([\d-]\d\.\d\d) # B-V index 153 ([A-Z].)\s # Spectral Type 154 (\d) # Multiplicity 155 }x or do { 156 warn "$ME Warning: This does not look like a hipXXX.dat file\n"; 157 warn "$ME: Cowardly aborting. Consider using --force or perhaps --undo.\n"; 158 $ABORT = 1; 159 return $d1 . $line . $tail; 160 }; 161 162 my $gname; 163 my $name; 164 165 #--- Read names in new format 166 if ($line =~ s/^$SEP\s*//) { 167 $name = $line =~ s/\s*$SEP\s*(.*)// ? $1 : ""; 168 $gname = $line || ""; 169 } 170 171 #--- Read names in old format 172 else { 173 $gname = $line =~ s/\s?:\s?(.*)// ? $1 : ""; 174 $name = $line || ""; 175 } 176 177 my $names; 178 179 #--- Write names in old format 180 if ($reverse) { 181 $names = $name; 182 $name and $gname and $names .= " "; 183 $gname and $names .= ": $gname"; 184 } 185 186 #--- Write names in new format 187 else { 188 $names = "$SEP "; 189 $names .= $gname ? $gname : " " x $GNAME_LEN; 190 $name and $names .= "$SEP $name"; 191 } 192 return $d1 . $names . $tail; 193} 194 195__END__ 196