[844] | 1 | package LATMOS::Accounts::Cli; |
---|
| 2 | |
---|
[2175] | 3 | # $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $ |
---|
[848] | 4 | |
---|
[844] | 5 | use strict; |
---|
| 6 | use warnings; |
---|
[2209] | 7 | use Moose; |
---|
[844] | 8 | use LATMOS::Accounts::Log; |
---|
[847] | 9 | use LATMOS::Accounts::Utils; |
---|
[844] | 10 | use Term::ReadLine; |
---|
| 11 | use Text::ParseWords; |
---|
[861] | 12 | use Getopt::Long; |
---|
[2209] | 13 | use LATMOS::Accounts::Cli::Object; |
---|
[844] | 14 | |
---|
[2209] | 15 | extends 'LATMOS::Accounts::Cli::Base'; |
---|
| 16 | |
---|
[1023] | 17 | =head1 NAME |
---|
| 18 | |
---|
| 19 | LATMOS::Accounts::Cli - Command line interface functions |
---|
| 20 | |
---|
| 21 | =head1 DESCRIPTION |
---|
| 22 | |
---|
| 23 | This module handle envirronment and functons for L<la-cli> tools. |
---|
| 24 | |
---|
| 25 | =cut |
---|
| 26 | |
---|
| 27 | =head1 FUNCTIONS |
---|
| 28 | |
---|
| 29 | =cut |
---|
| 30 | |
---|
| 31 | =head2 globalenv |
---|
| 32 | |
---|
| 33 | Return the main envirronement object |
---|
| 34 | |
---|
| 35 | =cut |
---|
| 36 | |
---|
[2386] | 37 | sub _create_from_handle { |
---|
| 38 | my ($self, $fh, $otype, $objname) = @_; |
---|
| 39 | |
---|
| 40 | my $labase = $self->base; |
---|
| 41 | |
---|
| 42 | my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh); |
---|
| 43 | if ($objname && (my $obj = $labase->get_object($otype, $objname))) { |
---|
| 44 | warn "Object $otype $objname already exists, aborting\n"; |
---|
| 45 | return; |
---|
| 46 | } else { |
---|
| 47 | if ($objname) { |
---|
| 48 | my $res = $labase->create_c_object($otype, $objname, %attr); |
---|
| 49 | if($res) { |
---|
[2397] | 50 | $self->print("Changes applied\n"); |
---|
[2386] | 51 | $labase->commit; |
---|
| 52 | return 1; |
---|
| 53 | } |
---|
| 54 | return 0; |
---|
| 55 | } else { |
---|
| 56 | my $ochelper = $labase->ochelper($otype); |
---|
| 57 | |
---|
| 58 | my $info = { |
---|
| 59 | contents => { %attr }, |
---|
| 60 | }; |
---|
| 61 | if ($attr{name}) { |
---|
| 62 | $info->{name}{content} = $attr{name}; |
---|
| 63 | } |
---|
| 64 | |
---|
| 65 | $ochelper->Automate($info) or do { |
---|
| 66 | warn "Cannot create object:" . LATMOS::Accounts::Log::lastmessage() . "\n"; |
---|
| 67 | return; |
---|
| 68 | }; |
---|
| 69 | return 1; |
---|
| 70 | } |
---|
| 71 | } |
---|
| 72 | } |
---|
| 73 | |
---|
[2400] | 74 | =head1 CLI FUNCTIONS |
---|
| 75 | |
---|
| 76 | =head2 GLOBAL FUNCTIONS |
---|
| 77 | |
---|
| 78 | =cut |
---|
| 79 | |
---|
[2209] | 80 | sub BUILD { |
---|
| 81 | my ( $self ) = @_; |
---|
| 82 | |
---|
| 83 | my $labase = $self->base; |
---|
| 84 | |
---|
| 85 | $self->add_func('ls', { |
---|
[844] | 86 | help => 'ls object_type - list object of type object_type', |
---|
| 87 | completion => sub { |
---|
[847] | 88 | if(!$_[2]) { |
---|
| 89 | return $_[0]->base->list_supported_objects |
---|
[844] | 90 | } else { () } |
---|
| 91 | }, |
---|
| 92 | code => sub { |
---|
[2241] | 93 | my $env = shift; |
---|
| 94 | my @args = $self->getoption( |
---|
| 95 | { |
---|
| 96 | 'fmt=s' => \my $fmt, |
---|
| 97 | 'filefmt=s' => \my $filefmt, |
---|
| 98 | }, @_ |
---|
| 99 | ); |
---|
| 100 | |
---|
| 101 | my $otype = $args[0] or do { |
---|
[2397] | 102 | $self->print("Object type missing\n"); |
---|
[2241] | 103 | return 1; |
---|
| 104 | }; |
---|
| 105 | |
---|
| 106 | if ($filefmt){ |
---|
[2386] | 107 | open(my $hfmt, '<', $filefmt) or do { |
---|
| 108 | warn "Cannot open $filefmt\n"; |
---|
| 109 | return; |
---|
| 110 | }; |
---|
[2241] | 111 | $fmt ||= ''; # avoid undef warning |
---|
| 112 | while (<$hfmt>) { |
---|
| 113 | chomp($fmt .= $_); |
---|
| 114 | } |
---|
| 115 | close $hfmt; |
---|
[844] | 116 | } |
---|
[2241] | 117 | |
---|
| 118 | if ($fmt) { |
---|
| 119 | foreach ($env->base->list_objects($otype)) { |
---|
| 120 | my $obj = $env->base->get_object($otype, $_) or next; |
---|
[2397] | 121 | $self->print($obj->queryformat($fmt)); |
---|
[2241] | 122 | } |
---|
[2397] | 123 | $self->print("\n"); |
---|
[2241] | 124 | } else { |
---|
[2397] | 125 | $self->print(map { "$_\n" } $env->base->list_objects($otype)); |
---|
[2241] | 126 | } |
---|
[844] | 127 | }, |
---|
| 128 | }); |
---|
[2209] | 129 | $self->add_func('search', { |
---|
[847] | 130 | help => 'search objecttype filter1 [filter2...] - search object according filter', |
---|
| 131 | completion => sub { |
---|
[2401] | 132 | my ($self, $ritem, $rotype) = @_; |
---|
[847] | 133 | if(!$_[2]) { |
---|
[2401] | 134 | return $self->base->list_supported_objects |
---|
[2374] | 135 | } else { |
---|
[2401] | 136 | my $parse; |
---|
| 137 | $parse = sub { |
---|
| 138 | my ($otype, $item) = @_; |
---|
| 139 | $item ||= ''; |
---|
| 140 | my ($NegFilter, $attr, $dot, $attrref, $operator, $val) = $item =~ /^([\!\+\-]?)(\w+)(?:(\.)([\.\w]+))?(?:([^\w*]+)(.+))?$/; |
---|
| 141 | if ($dot) { |
---|
| 142 | my $attribute = $self->base->attribute($otype, $attr) or |
---|
| 143 | return ($self->base->list_canonical_fields( $otype, 'r' ) ); |
---|
| 144 | my $refotype = $attribute->reference; |
---|
| 145 | return map { "$attr." . $_ } $parse->($refotype, "$attrref$operator$val" ); |
---|
| 146 | } else { |
---|
| 147 | return($self->base->list_canonical_fields($otype, 'r')); |
---|
| 148 | } |
---|
| 149 | |
---|
| 150 | }; |
---|
[2374] | 151 | return( |
---|
[2394] | 152 | map { $_, "!$_", "-$_", "+$_" } |
---|
[2401] | 153 | map { ( $_ . '=', $_ . '~' ) } $parse->( $rotype, $ritem ) |
---|
[2374] | 154 | ); |
---|
| 155 | } |
---|
[847] | 156 | }, |
---|
| 157 | code => sub { |
---|
[2209] | 158 | my ($self, @args) = @_; |
---|
[2419] | 159 | if ($args[0]) { |
---|
| 160 | if (!$self->base->is_supported_object($args[0])) { |
---|
| 161 | $self->print("$args[0] is an usupported object type\n"); |
---|
| 162 | } else { |
---|
| 163 | my @res = $self->base->search_objects(@args); |
---|
| 164 | $self->print(map { "$_\n" } @res); |
---|
| 165 | $self->{_lastsearch} = \@res; |
---|
| 166 | $self->{_lastsearchtype} = $args[0]; |
---|
| 167 | } |
---|
[847] | 168 | } else { |
---|
[2397] | 169 | $self->print("Object type missing\n"); |
---|
[847] | 170 | } |
---|
| 171 | }, |
---|
| 172 | }); |
---|
[2209] | 173 | $self->add_func('expired', { |
---|
[850] | 174 | help => 'expired [delay] - list expired account more than delay (default is now)', |
---|
| 175 | code => sub { |
---|
[2209] | 176 | my ($self, $expire) = @_; |
---|
| 177 | my @users = $self->base->find_expired_users($expire); |
---|
[2397] | 178 | $self->print(map { "$_\n" } @users); |
---|
[2209] | 179 | $self->{_lastsearchtype} = 'user'; |
---|
| 180 | $self->{_lastsearch} = \@users; |
---|
[850] | 181 | }, |
---|
[2209] | 182 | }) if ($self->base->can('find_expired_users')); |
---|
| 183 | $self->add_func('expires', { |
---|
[850] | 184 | help => 'expires [delay] - list account expiring before delay (default is 1 month)', |
---|
| 185 | code => sub { |
---|
[2209] | 186 | my ($self, $expire) = @_; |
---|
| 187 | my @users = $self->base->find_next_expire_users($expire); |
---|
[2397] | 188 | $self->print(map { "$_\n" } @users); |
---|
[2209] | 189 | $self->{_lastsearchtype} = 'user'; |
---|
| 190 | $self->{_lastsearch} = \@users; |
---|
[850] | 191 | }, |
---|
[2209] | 192 | }) if ($self->base->can('find_next_expire_users')); |
---|
| 193 | $self->add_func('select', { |
---|
[844] | 194 | help => 'select object_type - select objects to perform action on it', |
---|
| 195 | completion => sub { |
---|
| 196 | if ($_[2]) { |
---|
| 197 | return $_[0]->base->list_objects($_[2]); |
---|
| 198 | } else { |
---|
[847] | 199 | return '@', $_[0]->base->list_supported_objects; |
---|
[844] | 200 | } |
---|
| 201 | }, |
---|
| 202 | code => sub { |
---|
[2209] | 203 | my ($self, $otype, @ids) = @_; |
---|
[844] | 204 | my @objs; |
---|
[847] | 205 | if ($otype eq '@') { |
---|
[2209] | 206 | if (@{$self->{_lastsearch} || []}) { |
---|
| 207 | $otype = $self->{_lastsearchtype}; |
---|
| 208 | @ids = @{$self->{_lastsearch}}; |
---|
[847] | 209 | } else { |
---|
[2397] | 210 | $self->print("No results store from previous search\n"); |
---|
[847] | 211 | return; |
---|
| 212 | } |
---|
| 213 | } |
---|
[844] | 214 | if (!@ids) { |
---|
[2397] | 215 | $self->print('not enough arguments' . "\n"); |
---|
[844] | 216 | return; |
---|
| 217 | } |
---|
| 218 | foreach (@ids) { |
---|
[2209] | 219 | my $obj = $self->base->get_object($otype, $_) or do { |
---|
[2397] | 220 | $self->print("Cannot get $otype $_\n"); |
---|
[844] | 221 | return; |
---|
| 222 | }; |
---|
| 223 | push(@objs, $obj); |
---|
| 224 | } |
---|
[2426] | 225 | $self->print("Selecting $otype " . join(', ', map { $_->id } @objs) . "\n"); |
---|
[2209] | 226 | LATMOS::Accounts::Cli::Object->new( |
---|
[2216] | 227 | Parent => $self, |
---|
[2209] | 228 | Context => $self->Context, |
---|
| 229 | otype => $otype, |
---|
| 230 | objs => \@objs, |
---|
| 231 | )->cli(); |
---|
[844] | 232 | }, |
---|
| 233 | }); |
---|
[2459] | 234 | |
---|
[2456] | 235 | =head2 testpass |
---|
[2400] | 236 | |
---|
[2459] | 237 | Test password for given user |
---|
| 238 | |
---|
[2456] | 239 | =cut |
---|
| 240 | |
---|
| 241 | $self->add_func('testpass', { |
---|
| 242 | completion => sub { |
---|
| 243 | if (! $_[2]) { |
---|
| 244 | return $_[0]->base->list_objects('user'); |
---|
| 245 | } |
---|
| 246 | }, |
---|
| 247 | code => sub { |
---|
| 248 | my ($self, $user, @passwd) = @_; |
---|
| 249 | my $uobj = $self->base->get_object('user', $user) or do { |
---|
| 250 | $self->print("Cannot get user $user\n"); |
---|
| 251 | return; |
---|
| 252 | }; |
---|
| 253 | |
---|
| 254 | if (! $uobj->CheckAccountValidity ) { |
---|
| 255 | $self->print("Account $user cannot currently log\n"); |
---|
| 256 | } |
---|
| 257 | |
---|
| 258 | foreach (@passwd) { |
---|
| 259 | my $is = $uobj->ComparePassword( $_ ); |
---|
| 260 | if ($is) { |
---|
| 261 | $self->print("Passord for $user is $_\n"); |
---|
| 262 | last; |
---|
| 263 | } |
---|
| 264 | } |
---|
| 265 | }, |
---|
| 266 | }); |
---|
| 267 | |
---|
[2400] | 268 | =head3 create |
---|
| 269 | |
---|
| 270 | Create object |
---|
| 271 | |
---|
[2402] | 272 | |
---|
[2400] | 273 | =over 4 |
---|
| 274 | |
---|
| 275 | =item -i |
---|
| 276 | |
---|
| 277 | interactive: will prompt for attribute |
---|
| 278 | |
---|
| 279 | =item -f FILE |
---|
| 280 | |
---|
| 281 | Read file for attribute value |
---|
| 282 | |
---|
| 283 | =item -e |
---|
| 284 | |
---|
| 285 | open an epty file instead instead attribute list |
---|
| 286 | |
---|
| 287 | =item --ro |
---|
| 288 | |
---|
| 289 | Open an empty with attribute even read-only one |
---|
| 290 | |
---|
| 291 | =back |
---|
[2402] | 292 | |
---|
[2400] | 293 | =cut |
---|
| 294 | |
---|
[2209] | 295 | $self->add_func('create', { |
---|
[861] | 296 | code => sub { |
---|
[2386] | 297 | my $self = shift; |
---|
| 298 | my ($otype, $objname) = $self->getoption( |
---|
| 299 | { |
---|
| 300 | 'i' => \my $interactive, |
---|
| 301 | 'f=s' => \my $inputfile, |
---|
| 302 | 'ro' => \my $with_ro, |
---|
| 303 | 'e' => \my $empty_file, |
---|
| 304 | }, @_ |
---|
| 305 | ); |
---|
[861] | 306 | |
---|
[2438] | 307 | if (!$otype) { |
---|
| 308 | $self->print("No object type given\n"); |
---|
| 309 | return; |
---|
| 310 | } |
---|
| 311 | |
---|
[2386] | 312 | if ( $interactive ) { |
---|
| 313 | my $helper = $self->base->ochelper($otype); |
---|
| 314 | my $info = undef; |
---|
| 315 | while (1) { |
---|
| 316 | my $status; |
---|
| 317 | ($status, $info) = $helper->step($info); |
---|
| 318 | |
---|
| 319 | if ($status ne 'NEEDINFO') { |
---|
| 320 | if ($status eq 'CREATED') { |
---|
[2397] | 321 | $self->print("Object created\n"); |
---|
[2386] | 322 | $self->commit; |
---|
| 323 | } else { |
---|
[2397] | 324 | $self->print("Nothing done\n"); |
---|
[2386] | 325 | $self->rollback; |
---|
| 326 | } |
---|
| 327 | return; |
---|
[861] | 328 | } |
---|
| 329 | |
---|
[2386] | 330 | if ($info->{name}{ask}) { |
---|
| 331 | my $line = $self->Context->Term->readline("Name of the object ?"); |
---|
| 332 | $info->{name}{content} = $line; |
---|
| 333 | } |
---|
| 334 | foreach my $attr (@{$info->{ask} || []}) { |
---|
| 335 | $self->Context->Term->Attribs->{completion_function} = sub { |
---|
[861] | 336 | $info->{contents}{$attr} |
---|
[2386] | 337 | }; |
---|
| 338 | my $line = $self->Context->Term->readline(sprintf(' %s %s? ', |
---|
| 339 | $attr, |
---|
| 340 | $info->{contents}{$attr} |
---|
| 341 | ? '(' . $info->{contents}{$attr} . ') ' |
---|
| 342 | : '' |
---|
| 343 | )); |
---|
| 344 | $info->{contents}{$attr} = $line if($line); |
---|
| 345 | } |
---|
[861] | 346 | } |
---|
[2386] | 347 | } elsif ($inputfile) { |
---|
| 348 | my $handle; |
---|
| 349 | open($handle, '<', $inputfile) or do { |
---|
| 350 | warn "Cannot open input file $@\n"; |
---|
| 351 | return; |
---|
| 352 | }; |
---|
| 353 | my $res = $self->_create_from_handle($handle, $otype, $objname); |
---|
| 354 | close($handle); |
---|
| 355 | $self->commit if($res); |
---|
| 356 | return($res); |
---|
| 357 | } else { |
---|
| 358 | return LATMOS::Accounts::Utils::dump_read_temp_file( |
---|
| 359 | sub { |
---|
| 360 | my ($fh) = @_; |
---|
| 361 | $labase->text_empty_dump($fh, $otype, |
---|
| 362 | { |
---|
| 363 | only_rw => !$with_ro, |
---|
| 364 | } |
---|
| 365 | ) unless($empty_file); |
---|
| 366 | }, |
---|
| 367 | sub { |
---|
| 368 | my ($fh) = @_; |
---|
| 369 | if (my $res = $self->_create_from_handle($fh, $otype, $objname)) { |
---|
| 370 | $self->commit; |
---|
| 371 | return $res; |
---|
| 372 | } else { |
---|
| 373 | return; |
---|
| 374 | } |
---|
| 375 | } |
---|
| 376 | ); |
---|
[861] | 377 | } |
---|
| 378 | }, |
---|
[2386] | 379 | completion => sub { |
---|
| 380 | my ($self, $carg, @args) = @_; |
---|
| 381 | my @options = (); |
---|
| 382 | push( @options, qw(-i -f) ) unless ( grep { $_ =~ /^-[fi]$/ } @args ); |
---|
| 383 | push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args ); |
---|
| 384 | |
---|
| 385 | if (($args[-1] || '') eq '-f') { |
---|
| 386 | my $attribs = $self->Context->Term->Attribs; |
---|
| 387 | return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'}); |
---|
| 388 | } else { |
---|
| 389 | return (@options, $self->base->list_supported_objects); |
---|
| 390 | } |
---|
| 391 | }, |
---|
[861] | 392 | } |
---|
| 393 | ); |
---|
[2209] | 394 | $self->add_func('exchangeip', |
---|
[861] | 395 | { |
---|
| 396 | help => 'Exchange two IP on host', |
---|
| 397 | code => sub { |
---|
[2209] | 398 | my ($self, @args) = @_; |
---|
[861] | 399 | my ($ip1, $ip2) = |
---|
| 400 | grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args; |
---|
| 401 | if (!$ip2) { |
---|
[2397] | 402 | $self->print("Need two ip to exchange\n"); |
---|
[861] | 403 | return; |
---|
| 404 | } |
---|
[2209] | 405 | if ($self->base->nethost_exchange_ip($ip1, $ip2)) { |
---|
[2397] | 406 | $self->print("$ip1 and $ip2 get exchange\n"); |
---|
[2209] | 407 | $self->commit; |
---|
[861] | 408 | } else { |
---|
[2209] | 409 | $self->rollback; |
---|
[861] | 410 | } |
---|
| 411 | }, |
---|
| 412 | completion => sub { |
---|
[2209] | 413 | my ($self, $carg, @args) = @_; |
---|
[861] | 414 | if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) { |
---|
[2209] | 415 | if (my $obj = $self->base->get_object('nethost', $args[-1])) { |
---|
[861] | 416 | return $obj->get_attributes('ip'); |
---|
| 417 | } |
---|
| 418 | } else { |
---|
| 419 | my @list = |
---|
[2209] | 420 | ($self->base->attributes_summary('nethost', 'ip'), |
---|
| 421 | $self->base->list_objects('nethost')); |
---|
[861] | 422 | return @list; |
---|
| 423 | } |
---|
| 424 | }, |
---|
| 425 | } |
---|
| 426 | ); |
---|
[2284] | 427 | |
---|
| 428 | $self->add_func('loadcsv', |
---|
| 429 | { |
---|
| 430 | help => 'Load CSV file to create object', |
---|
| 431 | code => sub { |
---|
| 432 | my ($self, $otype, $file) = @_; |
---|
| 433 | |
---|
| 434 | open(my $fh, '<', $file) or do { |
---|
| 435 | warn "Cannot open $file $!\n"; |
---|
| 436 | return; |
---|
| 437 | }; |
---|
| 438 | |
---|
| 439 | my @ids; |
---|
| 440 | |
---|
| 441 | loadCSV( |
---|
| 442 | $fh, |
---|
| 443 | cb => sub { |
---|
| 444 | my ($res, $linecount) = @_; |
---|
| 445 | |
---|
| 446 | my $ochelper = $labase->ochelper($otype); |
---|
| 447 | |
---|
| 448 | my $info = { |
---|
| 449 | contents => $res |
---|
| 450 | }; |
---|
| 451 | if ($res->{name}) { |
---|
| 452 | $info->{name}{content} = $res->{name}; |
---|
| 453 | } |
---|
| 454 | |
---|
[2286] | 455 | if (my $id = $ochelper->Automate($info)) { |
---|
| 456 | push(@ids, $id); |
---|
[2284] | 457 | } else { |
---|
| 458 | warn "Cannot create object line $linecount (not enough information ?)\n"; |
---|
| 459 | } |
---|
| 460 | }, |
---|
| 461 | ); |
---|
| 462 | |
---|
| 463 | close($fh); |
---|
| 464 | |
---|
| 465 | my @objs; |
---|
| 466 | foreach (@ids) { |
---|
| 467 | my $obj = $self->base->get_object($otype, $_) or do { |
---|
[2397] | 468 | $self->print("Cannot get $otype $_\n"); |
---|
[2284] | 469 | return; |
---|
| 470 | }; |
---|
| 471 | push(@objs, $obj); |
---|
| 472 | } |
---|
| 473 | |
---|
[2397] | 474 | $self->print("Selecting $otype " . join(', ', @ids) . "\n"); |
---|
[2284] | 475 | LATMOS::Accounts::Cli::Object->new( |
---|
| 476 | Parent => $self, |
---|
| 477 | Context => $self->Context, |
---|
| 478 | otype => $otype, |
---|
| 479 | objs => \@objs, |
---|
| 480 | )->cli(); |
---|
| 481 | }, |
---|
| 482 | completion => sub { |
---|
| 483 | if ($_[2]) { |
---|
| 484 | return Term::ReadLine::Gnu::filename_list(@_); |
---|
| 485 | } else { |
---|
| 486 | return '@', $_[0]->base->list_supported_objects; |
---|
| 487 | } |
---|
| 488 | }, |
---|
| 489 | } |
---|
| 490 | ); |
---|
| 491 | |
---|
[2209] | 492 | $self->add_func('user', { alias => [qw'select user' ] }); |
---|
| 493 | $self->add_func('group', { alias => [qw'select group'] }); |
---|
| 494 | return $self |
---|
[844] | 495 | } |
---|
| 496 | |
---|
| 497 | 1; |
---|
[1023] | 498 | |
---|
| 499 | __END__ |
---|
| 500 | |
---|
| 501 | =head1 SEE ALSO |
---|
| 502 | |
---|
| 503 | L<LATMOS::Accounts> |
---|
| 504 | |
---|
| 505 | =head1 AUTHOR |
---|
| 506 | |
---|
| 507 | Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt> |
---|
| 508 | |
---|
| 509 | =head1 COPYRIGHT AND LICENSE |
---|
| 510 | |
---|
| 511 | Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS |
---|
| 512 | |
---|
| 513 | This library is free software; you can redistribute it and/or modify |
---|
| 514 | it under the same terms as Perl itself, either Perl version 5.10.0 or, |
---|
| 515 | at your option, any later version of Perl 5 you may have available. |
---|
| 516 | |
---|
| 517 | =cut |
---|