| 389 | | == OOP 関連 == |
| 390 | | === 引数設定の自動化もどき === |
| 391 | | * 意味があるのかどうかは知らん. |
| 392 | | {{{ |
| 393 | | #!perl |
| 394 | | use strict; |
| 395 | | use warnings; |
| 396 | | use diagnostics; |
| 397 | | use Carp; |
| 398 | | |
| 399 | | { |
| 400 | | package Base; |
| 401 | | |
| 402 | | sub new ($%) { |
| 403 | | my ($class, %argv) = @_; |
| 404 | | my $self = bless {__class__ => $class}, $class; |
| 405 | | return $self->__init__(%argv); |
| 406 | | } |
| 407 | | |
| 408 | | sub __init__ ($%) { |
| 409 | | my ($self, %argv) = @_; |
| 410 | | |
| 411 | | while (my ($key, $val) = each(%argv)) { |
| 412 | | $self->{$key} = $val; |
| 413 | | } |
| 414 | | return $self; |
| 415 | | } |
| 416 | | |
| 417 | | sub __class__ ($) { |
| 418 | | my $self = shift; |
| 419 | | return $self->{__class__}; |
| 420 | | } |
| 421 | | |
| 422 | | sub __check__ ($@) { |
| 423 | | my ($self, @requisite) = @_; |
| 424 | | foreach (@requisite) { |
| 425 | | Carp::confess $self->__class__(), " requires argument ", $_ |
| 426 | | unless (exists($self->{$_})); |
| 427 | | } |
| 428 | | } |
| 429 | | |
| 430 | | 1; |
| 431 | | } |
| 432 | | |
| 433 | | { |
| 434 | | package Parent; |
| 435 | | |
| 436 | | use base qw(Base); |
| 437 | | |
| 438 | | sub __init__ ($%) { |
| 439 | | my @requisite = qw(parentname); |
| 440 | | |
| 441 | | my ($self, %argv) = @_; |
| 442 | | |
| 443 | | $self->SUPER::__init__(%argv); |
| 444 | | $self->SUPER::__check__(@requisite); |
| 445 | | |
| 446 | | return $self; |
| 447 | | } |
| 448 | | |
| 449 | | sub parent ($) { |
| 450 | | my $self = shift; |
| 451 | | printf "parent is %s\n", $self->{parentname}; |
| 452 | | } |
| 453 | | |
| 454 | | 1; |
| 455 | | } |
| 456 | | |
| 457 | | { |
| 458 | | package Child; |
| 459 | | |
| 460 | | use base qw(Parent); |
| 461 | | |
| 462 | | sub __init__ ($%) { |
| 463 | | my @requisite = qw(childname); |
| 464 | | |
| 465 | | my ($self, %argv) = @_; |
| 466 | | |
| 467 | | $self->SUPER::__init__(%argv); |
| 468 | | $self->SUPER::__check__(@requisite); |
| 469 | | |
| 470 | | return $self; |
| 471 | | } |
| 472 | | |
| 473 | | sub child ($) { |
| 474 | | my $self = shift; |
| 475 | | printf "child is %s\n", $self->{childname}; |
| 476 | | } |
| 477 | | |
| 478 | | 1; |
| 479 | | } |
| 480 | | |
| 481 | | my $parent = new Parent(parentname => "jobs"); |
| 482 | | $parent->parent(); |
| 483 | | |
| 484 | | my $child = new Child(childname => "michael", parentname => "mike"); |
| 485 | | $child->parent(); |
| 486 | | $child->child(); |
| 487 | | }}} |
| | 313 | == Java で言う instanceof == |
| | 314 | * UNIVERSAL を使う |
| | 315 | {{{ |
| | 316 | #!perl |
| | 317 | use strict; |
| | 318 | use warnings; |
| | 319 | use UNIVERSAL qw(isa); |
| | 320 | use IO::File; |
| | 321 | |
| | 322 | my $fh = new IO::File("hoge"); |
| | 323 | |
| | 324 | if ( isa( $fh, "IO::Handle" ) ) { |
| | 325 | ... |
| | 326 | } |
| | 327 | }}} |
| | 328 | * IO::File は IO::Handle のサブクラスなので true |
| | 329 | |
| | 330 | == あるオブジェクトにあるメソッドが定義されているかどうか調べる == |
| | 331 | * UNIVERSAL を使う |
| | 332 | {{{ |
| | 333 | #!perl |
| | 334 | use strict; |
| | 335 | use warnings; |
| | 336 | use UNIVERSAL qw(can); |
| | 337 | use IO::File; |
| | 338 | |
| | 339 | my $fh = new IO::File("hoge"); |
| | 340 | |
| | 341 | if ( can( $fh, "print" ) ) { |
| | 342 | ... |
| | 343 | } |
| | 344 | }}} |
| | 345 | * IO::File には print メソッドが定義されているので true |
| 543 | | }}} |
| 544 | | |
| 545 | | == ステップつきスライス == |
| 546 | | * つまるところ Python での {{{list[start:end:step]}}}.ただし Python のように step に 0 以下の値を入れられない. |
| 547 | | {{{ |
| 548 | | #!perl |
| 549 | | use Clone qw(clone); |
| 550 | | |
| 551 | | my @array = (100 .. 150); |
| 552 | | my $step = 3; |
| 553 | | |
| 554 | | for (0 .. 10) { |
| 555 | | print join(", ", &slice(\@array, $_, $#array, $step)), "\n"; |
| 556 | | } |
| 557 | | |
| 558 | | sub slice($$$$) { |
| 559 | | my ($array, $start, $end, $step) = @_; |
| 560 | | my @subs = (); |
| 561 | | |
| 562 | | for (my $i = $start; $i < $end; $i += $step) { |
| 563 | | push(@subs, clone($array->[$i])); |
| 564 | | } |
| 565 | | |
| 566 | | return @subs; |
| 567 | | } |
| 568 | | }}} |
| 569 | | * 実行結果 |
| 570 | | {{{ |
| 571 | | 100, 103, 106, 109, 112, 115, 118, 121, 124, 127, 130, 133, 136, 139, 142, 145, 148 |
| 572 | | 101, 104, 107, 110, 113, 116, 119, 122, 125, 128, 131, 134, 137, 140, 143, 146, 149 |
| 573 | | 102, 105, 108, 111, 114, 117, 120, 123, 126, 129, 132, 135, 138, 141, 144, 147 |
| 574 | | 103, 106, 109, 112, 115, 118, 121, 124, 127, 130, 133, 136, 139, 142, 145, 148 |
| 575 | | 104, 107, 110, 113, 116, 119, 122, 125, 128, 131, 134, 137, 140, 143, 146, 149 |
| 576 | | 105, 108, 111, 114, 117, 120, 123, 126, 129, 132, 135, 138, 141, 144, 147 |
| 577 | | 106, 109, 112, 115, 118, 121, 124, 127, 130, 133, 136, 139, 142, 145, 148 |
| 578 | | 107, 110, 113, 116, 119, 122, 125, 128, 131, 134, 137, 140, 143, 146, 149 |
| 579 | | 108, 111, 114, 117, 120, 123, 126, 129, 132, 135, 138, 141, 144, 147 |
| 580 | | 109, 112, 115, 118, 121, 124, 127, 130, 133, 136, 139, 142, 145, 148 |
| 581 | | 110, 113, 116, 119, 122, 125, 128, 131, 134, 137, 140, 143, 146, 149 |