RZ

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