1package App::Sqitch::Command::config; 2 3use 5.010; 4use strict; 5use warnings; 6use utf8; 7use Path::Class (); 8use Try::Tiny; 9use Locale::TextDomain qw(App-Sqitch); 10use App::Sqitch::X qw(hurl); 11use List::Util qw(first); 12use Moo; 13use App::Sqitch::Types qw(Str Dir Maybe); 14use Type::Utils qw(enum); 15use namespace::autoclean; 16extends 'App::Sqitch::Command'; 17 18our $VERSION = '0.9994'; 19 20has file => ( 21 is => 'ro', 22 lazy => 1, 23 default => sub { 24 my $self = shift; 25 my $meth = ( $self->context || 'local' ) . '_file'; 26 return $self->sqitch->config->$meth; 27 } 28); 29 30has action => ( 31 is => 'ro', 32 isa => enum([qw( 33 get 34 get_all 35 get_regex 36 set 37 unset 38 list 39 edit 40 add 41 replace_all 42 unset_all 43 rename_section 44 remove_section 45 )]), 46); 47 48has context => ( 49 is => 'ro', 50 isa => Maybe[enum([qw( 51 local 52 user 53 system 54 )])], 55); 56 57has type => ( is => 'ro', isa => enum( [qw(int num bool bool-or-int)] ) ); 58 59sub options { 60 return qw( 61 file|config-file|f=s 62 local 63 user 64 system 65 66 int 67 bool 68 bool-or-int 69 num 70 71 get 72 get-all 73 get-regex|get-regexp 74 add 75 replace-all 76 unset 77 unset-all 78 rename-section 79 remove-section 80 list|l 81 edit|e 82 ); 83} 84 85sub configure { 86 my ( $class, $config, $opt ) = @_; 87 88 # Make sure we are accessing only one file. 89 my @file = grep { $opt->{$_} } qw(local user system file); 90 $class->usage('Only one config file at a time.') if @file > 1; 91 92 # Make sure we have only one type. 93 my @type = grep { $opt->{$_} } qw(bool int num bool_or_int); 94 $class->usage('Only one type at a time.') if @type > 1; 95 96 # Make sure we are performing only one action. 97 my @action = grep { $opt->{$_} } qw( 98 get 99 get_all 100 get_regex 101 unset 102 list 103 edit 104 add 105 replace_all 106 unset_all 107 rename_section 108 remove_section 109 ); 110 $class->usage('Only one action at a time.') if @action > 1; 111 112 # Get the action and context. 113 my $context = first { $opt->{$_} } qw(local user system); 114 115 # Make it so. 116 return { 117 ( $action[0] ? ( action => $action[0] ) : () ), 118 ( $type[0] ? ( type => $type[0] ) : () ), 119 ( $context ? ( context => $context ) : () ), 120 ( $opt->{file} ? ( file => $opt->{file} ) : () ), 121 }; 122} 123 124sub execute { 125 my $self = shift; 126 my $action = $self->action || ( @_ > 1 ? 'set' : 'get' ); 127 $action =~ s/-/_/g; 128 my $meth = $self->can($action) or hurl config => __x( 129 'Unknown config action: {action}', 130 action => $action, 131 ); 132 return $self->$meth(@_); 133} 134 135sub get { 136 my ( $self, $key, $rx ) = @_; 137 $self->usage('Wrong number of arguments.') if !defined $key || $key eq ''; 138 139 my $val = try { 140 $self->sqitch->config->get( 141 key => $key, 142 filter => $rx, 143 as => $self->type, 144 human => 1, 145 ); 146 } 147 catch { 148 hurl config => __x( 149 'More then one value for the key "{key}"', 150 key => $key, 151 ) if /^\QMultiple values/i; 152 hurl config => $_; 153 }; 154 155 hurl { 156 ident => 'config', 157 message => '', 158 exitval => 1, 159 } unless defined $val; 160 $self->emit($val); 161 return $self; 162} 163 164sub get_all { 165 my ( $self, $key, $rx ) = @_; 166 $self->usage('Wrong number of arguments.') if !defined $key || $key eq ''; 167 168 my @vals = try { 169 $self->sqitch->config->get_all( 170 key => $key, 171 filter => $rx, 172 as => $self->type, 173 human => 1, 174 ); 175 } 176 catch { 177 hurl config => $_; 178 }; 179 hurl { 180 ident => 'config', 181 message => '', 182 exitval => 1, 183 } unless @vals; 184 $self->emit( join "\n", @vals ); 185 return $self; 186} 187 188sub get_regex { 189 my ( $self, $key, $rx ) = @_; 190 $self->usage('Wrong number of arguments.') if !defined $key || $key eq ''; 191 192 my $config = $self->sqitch->config; 193 my %vals = try { 194 $config->get_regexp( 195 key => $key, 196 filter => $rx, 197 as => $self->type, 198 human => 1, 199 ); 200 } 201 catch { 202 hurl config => $_; 203 }; 204 hurl { 205 ident => 'config', 206 message => '', 207 exitval => 1, 208 } unless %vals; 209 my @out; 210 for my $key ( sort keys %vals ) { 211 if ( defined $vals{$key} ) { 212 if ( $config->is_multiple($key) ) { 213 push @out => "$key=[" . join( ', ', @{ $vals{$key} } ) . ']'; 214 } 215 else { 216 push @out => "$key=$vals{$key}"; 217 } 218 } 219 else { 220 push @out => $key; 221 } 222 } 223 $self->emit( join "\n" => @out ); 224 225 return $self; 226} 227 228sub set { 229 my ( $self, $key, $value, $rx ) = @_; 230 $self->_set( $key, $value, $rx, multiple => 0 ); 231} 232 233sub add { 234 my ( $self, $key, $value ) = @_; 235 $self->_set( $key, $value, undef, multiple => 1 ); 236} 237 238sub replace_all { 239 my ( $self, $key, $value, $rx ) = @_; 240 $self->_set( $key, $value, $rx, multiple => 1, replace_all => 1 ); 241} 242 243sub _set { 244 my ( $self, $key, $value, $rx, @p ) = @_; 245 $self->usage('Wrong number of arguments.') 246 if !defined $key || $key eq '' || !defined $value; 247 248 $self->_touch_dir; 249 try { 250 $self->sqitch->config->set( 251 key => $key, 252 value => $value, 253 filename => $self->file, 254 filter => $rx, 255 as => $self->type, 256 @p, 257 ); 258 } 259 catch { 260 hurl config => __( 261 'Cannot overwrite multiple values with a single value' 262 ) if /^Multiple occurrences/i; 263 hurl config => $_; 264 }; 265 return $self; 266} 267 268sub _file_config { 269 my $file = shift->file; 270 return unless -e $file; 271 my $config = App::Sqitch::Config->new; 272 $config->load_file($file); 273 return $config; 274} 275 276sub unset { 277 my ( $self, $key, $rx ) = @_; 278 $self->usage('Wrong number of arguments.') if !defined $key || $key eq ''; 279 $self->_touch_dir; 280 281 try { 282 $self->sqitch->config->set( 283 key => $key, 284 filename => $self->file, 285 filter => $rx, 286 multiple => 0, 287 ); 288 } 289 catch { 290 hurl config => __( 291 'Cannot unset key with multiple values' 292 ) if /^Multiple occurrences/i; 293 hurl config => $_; 294 }; 295 return $self; 296} 297 298sub unset_all { 299 my ( $self, $key, $rx ) = @_; 300 $self->usage('Wrong number of arguments.') if !defined $key || $key eq ''; 301 302 $self->_touch_dir; 303 $self->sqitch->config->set( 304 key => $key, 305 filename => $self->file, 306 filter => $rx, 307 multiple => 1, 308 ); 309 return $self; 310} 311 312sub list { 313 my $self = shift; 314 my $config = $self->context 315 ? $self->_file_config 316 : $self->sqitch->config; 317 $self->emit( scalar $config->dump ) if $config; 318 return $self; 319} 320 321sub edit { 322 my $self = shift; 323 324 # Let the editor deal with locking. 325 $self->shell( 326 $self->sqitch->editor . ' ' . $self->quote_shell( $self->file ) 327 ); 328} 329 330sub rename_section { 331 my ( $self, $old_name, $new_name ) = @_; 332 $self->usage('Wrong number of arguments.') 333 unless defined $old_name && $old_name ne '' 334 && defined $new_name && $new_name ne ''; 335 336 try { 337 $self->sqitch->config->rename_section( 338 from => $old_name, 339 to => $new_name, 340 filename => $self->file 341 ); 342 } 343 catch { 344 hurl config => __ 'No such section!' if /\Qno such section/i; 345 hurl config => $_; 346 }; 347 return $self; 348} 349 350sub remove_section { 351 my ( $self, $section ) = @_; 352 $self->usage('Wrong number of arguments.') 353 unless defined $section && $section ne ''; 354 try { 355 $self->sqitch->config->remove_section( 356 section => $section, 357 filename => $self->file 358 ); 359 } 360 catch { 361 hurl config => __ 'No such section!' if /\Qno such section/i; 362 hurl config => $_; 363 }; 364 return $self; 365} 366 367sub _touch_dir { 368 my $self = shift; 369 unless ( -e $self->file ) { 370 require File::Basename; 371 my $dir = File::Basename::dirname( $self->file ); 372 unless ( -e $dir && -d _ ) { 373 require File::Path; 374 File::Path::make_path($dir); 375 } 376 } 377} 378 3791; 380 381__END__ 382 383=head1 Name 384 385App::Sqitch::Command::config - Get and set local, user, or system Sqitch options 386 387=head1 Synopsis 388 389 my $cmd = App::Sqitch::Command::config->new(\%params); 390 $cmd->execute; 391 392=head1 Description 393 394You can query/set/replace/unset Sqitch options with this command. The name is 395actually the section and the key separated by a dot, and the value will be 396escaped. 397 398=head1 Interface 399 400=head2 Class Methods 401 402=head3 C<options> 403 404 my @opts = App::Sqitch::Command::config->options; 405 406Returns a list of L<Getopt::Long> option specifications for the command-line 407options for the C<config> command. 408 409=head3 C<configure> 410 411 my $params = App::Sqitch::Command::config->configure( 412 $config, 413 $options, 414 ); 415 416Processes the configuration and command options and returns a hash suitable 417for the constructor. Exits with an error on option specification errors. 418 419=head2 Constructor 420 421=head3 C<new> 422 423 my $config = App::Sqitch::Command::config->new($params); 424 425Creates and returns a new C<config> command object. The supported parameters 426include: 427 428=over 429 430=item C<sqitch> 431 432The core L<Sqitch|App::Sqitch> object. 433 434=item C<file> 435 436Configuration file to read from and write to. 437 438=item C<action> 439 440The action to be executed. May be one of: 441 442=over 443 444=item * C<get> 445 446=item * C<get-all> 447 448=item * C<get-regexp> 449 450=item * C<set> 451 452=item * C<add> 453 454=item * C<replace-all> 455 456=item * C<unset> 457 458=item * C<unset-all> 459 460=item * C<list> 461 462=item * C<edit> 463 464=item * C<rename-section> 465 466=item * C<remove-section> 467 468=back 469 470If not specified, the action taken by C<execute()> will depend on the number 471of arguments passed to it. If only one, the action will be C<get>. If two or 472more, the action will be C<set>. 473 474=item C<context> 475 476The configuration file context. Must be one of: 477 478=over 479 480=item * C<local> 481 482=item * C<user> 483 484=item * C<system> 485 486=back 487 488=item C<type> 489 490The type to cast a value to be set to or fetched as. May be one of: 491 492=over 493 494=item * C<bool> 495 496=item * C<int> 497 498=item * C<num> 499 500=item * C<bool-or-int> 501 502=back 503 504If not specified or C<undef>, no casting will be performed. 505 506=back 507 508=head2 Instance Methods 509 510These methods are mainly provided as utilities for the command subclasses to 511use. 512 513=head3 C<execute> 514 515 $config->execute($property, $value); 516 517Executes the config command. Pass the name of the property and the value to 518be assigned to it, if applicable. 519 520=head3 C<get> 521 522 $config->get($key); 523 $config->get($key, $regex); 524 525Emits the value for the specified key. The optional second argument is a 526regular expression that the value to be returned must match. Exits with an 527error if the is more than one value for the specified key, or if the key does 528not exist. 529 530=head3 C<get_all> 531 532 $config->get_all($key); 533 $config->get_all($key, $regex); 534 535Like C<get()>, but emits all of the values for the given key, rather then 536exiting with an error when there is more than one value. 537 538=head3 C<get_regex> 539 540 $config->get_regex($key); 541 $config->get_regex($key, $regex); 542 543Like C<get_all()>, but the first parameter is a regular expression that will 544be matched against all keys. 545 546=head3 C<set> 547 548 $config->set($key, $value); 549 $config->set($key, $value, $regex); 550 551Sets the value for a key. Exits with an error if the key already exists and 552has multiple values. 553 554=head3 C<add> 555 556 $config->add($key, $value); 557 558Adds a value for a key. If the key already exists, the value will be added as 559an additional value. 560 561=head3 C<replace_all> 562 563 $config->replace_all($key, $value); 564 $config->replace_all($key, $value, $regex); 565 566Replace all matching values. 567 568=head3 C<unset> 569 570 $config->unset($key); 571 $config->unset($key, $regex); 572 573Unsets a key. If the optional second argument is passed, the key will be unset 574only if the value matches the regular expression. If the key has multiple 575values, C<unset()> will exit with an error. 576 577=head3 C<unset_all> 578 579 $config->unset_all($key); 580 $config->unset_all($key, $regex); 581 582Like C<unset()>, but will not exit with an error if the key has multiple 583values. 584 585=head3 C<rename_section> 586 587 $config->rename_section($old_name, $new_name); 588 589Renames a section. Exits with an error if the section does not exist or if 590either name is not a valid section name. 591 592=head3 C<remove_section> 593 594 $config->remove_section($section); 595 596Removes a section. Exits with an error if the section does not exist. 597 598=head3 C<list> 599 600 $config->list; 601 602Lists all of the values in the configuration. If the context is C<local>, 603C<user>, or C<system>, only the settings set for that context will be emitted. 604Otherwise, all settings will be listed. 605 606=head3 C<edit> 607 608 $config->edit; 609 610Opens the context-specific configuration file in a text editor for direct 611editing. If no context is specified, the local config file will be opened. The 612editor is determined by L<Sqitch/editor>. 613 614=head2 Instance Accessors 615 616=head3 C<file> 617 618 my $file_name = $config->file; 619 620Returns the path to the configuration file to be acted upon. If the context is 621C<system>, then the value returned is C<$($etc_prefix)/sqitch.conf>. If the 622context is C<user>, then the value returned is C<~/.sqitch/sqitch.conf>. 623Otherwise, the default is F<./sqitch.conf>. 624 625=head1 See Also 626 627=over 628 629=item L<sqitch-config> 630 631Help for the C<config> command to the Sqitch command-line client. 632 633=item L<sqitch> 634 635The Sqitch command-line client. 636 637=back 638 639=head1 Author 640 641David E. Wheeler <david@justatheory.com> 642 643=head1 License 644 645Copyright (c) 2012-2015 iovation Inc. 646 647Permission is hereby granted, free of charge, to any person obtaining a copy 648of this software and associated documentation files (the "Software"), to deal 649in the Software without restriction, including without limitation the rights 650to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 651copies of the Software, and to permit persons to whom the Software is 652furnished to do so, subject to the following conditions: 653 654The above copyright notice and this permission notice shall be included in all 655copies or substantial portions of the Software. 656 657THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 658IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 659FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 660AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 661LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 662OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 663SOFTWARE. 664 665=cut 666 667