RZ

001: # GetoptAnalyze.pl # command line parser
002:
003: use strict;
004: use Getopt::Long;
005:
006: require "GetoptGlue.pl";
007:
008: package GetoptAnalyze; 
009:
010: ######## command line stuff ########
011:
012: my $verbosity = 0;
013: sub verbosity { $verbosity }
014: my $debug = 0;
015: sub debug { $debug }
016:
017: my %exclusion = ();
018: sub exclusive {
019:     my $x = shift;
020:     local( $" ) = " ";
021:     if ( exists $exclusion{ $x } ) {
022:         die "Mutually exclusive: $exclusion{ $x } and --@_\n";
023:     } else { $exclusion{ $x } = "--@_"; }
024: }
025:
026: my $backup_suffix = "~";
027: my $write_strategy = undef;
028: my %write_strategy;
029: @write_strategy{ 'departure', 'file', 'destination' } = ( 1, 0, 1 );
030: sub write_strategy {
031:     if ( defined $write_strategy ) {
032:         $write_strategy{ $_[0] } = $write_strategy;
033:         if ( $_[0] eq 'file') {
034:             $write_strategy & -3 and die "Inconsistent write/backup mode\n";
035:         } else {
036:             $write_strategy & -3 or die "Inconsistent write/backup mode\n";
037:         }
038:         undef $write_strategy;
039:     }
040: }
041:
042: my $conversion;
043:
044: ######## euwe gooey glue ########
045:
046: my $differh; sub differh { my $h = shift; $differh->( @_ ); }
047: my %backh; sub backh { my $h = shift; $backh{ $h }->( @_ ); }
048: my %openh; sub openh { my $h = shift; $openh{ $h }->( @_ ); }
049: my $closeh;                   sub closeh { $closeh->( @_ ); }
050: my $converth;             sub converth { $converth->( @_ ); }
051:
052: $differh                = sub {};
053: $backh{ departure }     = sub {};
054: $backh{ destination }   = sub {};
055: $closeh                 = GetoptGlue::closer();
056: $converth               = sub { 0 };
057:
058: ######## -- long options on the command line ########
059:
060: my @options = (
061:     'verbose+'                  => \$verbosity,
062:     'debug+'                    => \$debug,
063:
064:     'overwrite'                 => sub { $write_strategy = 0 },
065:     'remove-existing'           => sub { $write_strategy = 1 },
066:     'copy-aside-and-overwrite'  => sub { $write_strategy = 2 },
067:     'move-aside-existing'       => sub { $write_strategy = 3 },
068:
069:     'backup-suffix=s'           => \$backup_suffix,
070:
071:     'stdin-analyze' =>
072:     sub {
073:         exclusive( analyze => 'stdin-analyze' );
074:         $openh{ departure } = GetoptGlue::opener( "<-", "" );
075:     },
076:
077:     'analyze=s' =>
078:     sub {
079:         exclusive( analyze => @_ );
080:         $openh{ departure } = GetoptGlue::opener( "<", $_[1] );
081:     },
082:
083:     'convert-file=s' =>
084:     sub {
085:         exclusive( analyze => @_ );
086:         exclusive( 'concentrated-file' => @_ );
087:         write_strategy( file => @_ );
088:         $backh{ departure } = GetoptGlue::backer(
089:             $write_strategy{ file }, $_[1], $backup_suffix
090:         );
091:         $openh{ departure } = GetoptGlue::opener( "+<", $_[1] );
092:         if ( defined $conversion ) {
093:             $converth = GetoptGlue::converter( $_[1], $conversion );
094:         }
095:         else {
096:             $converth = GetoptGlue::converter( $_[1] );
097:             $conversion = $_[1];
098:         }
099:     },
100:
101:     'convert-departure=s' =>
102:     sub {
103:         exclusive( analyze => @_ );
104:         write_strategy( departure => @_ );
105:         $backh{ departure } = GetoptGlue::backer(
106:             $write_strategy{ departure }, $_[1], $backup_suffix
107:         );
108:         $openh{ departure } = GetoptGlue::opener( "<", $_[1] );
109:         if ( not defined $openh{ destination } ) {
110:             $openh{ destination } = GetoptGlue::opener( ">", $_[1] );
111:         }
112:     },
113:
114:     'concentrated-file=s' =>
115:     sub {
116:         exclusive( concentrated => @_ );
117:         exclusive( 'concentrated-file' => @_ );
118:         write_strategy( file => @_ );
119:         $differh = GetoptGlue::differ( $_[1] );
120:         $backh{ destination } = GetoptGlue::backer(
121:             $write_strategy{ file }, $_[1], $backup_suffix
122:         );
123:         $openh{ destination } = GetoptGlue::opener( ">", $_[1] );
124:     },
125:
126:     'concentrated-destination=s' =>
127:     sub {
128:         exclusive( concentrated => @_ );
129:         write_strategy( destination => @_ );
130:         $differh = GetoptGlue::differ( $_[1] );
131:         $backh{ destination } = GetoptGlue::backer(
132:             $write_strategy{ destination }, $_[1], $backup_suffix
133:         );
134:         $openh{ destination } = GetoptGlue::opener( ">", $_[1] );
135:         if ( defined $conversion ) {
136:             $converth = GetoptGlue::converter( $conversion, $_[1] );
137:         }
138:         else {
139:             $conversion = $_[1];
140:         }
141:     },
142: );
143:
144: ######## now do the command line parsing ########
145:
146: my $parser = new Getopt::Long::Parser;
147: $parser->configure( 'no_permute' );
148: $parser->getoptions( @options ) or die "Error in arguments\n";
149: if ( @ARGV ) {
150:     die "Unparsable arguments specified\n";
151: }
152: unless ( $openh{ departure } and ( $openh{ destination } or $converth ) ) {
153:     die "Incomplete arguments specified\n";
154: }
155:
156: # GetoptAnalyze.pl # command line parser
157:
158: 1;