new アラカルト

Perl 5.004に現れた標準モジュールの new メソッドを集めてみました。息切れしてIまでしか、行けませんでした。new メソッドのない標準モジュールも結構多いようです。

最も単純なnew()
sub new {
    my $self = {}
    bless( $self );
    return $self;
}

パラメータを引数としてとるnew()
sub new {
    my $class = shift;
    my $self = {};
    %$self = @_;
    bless( $self );
    return $self;
}
        利用法
        use Class;
        $object = new Class( NAME1=>data1, NAME2=>data2, ..);

パラメータを引数としてとるが、defaultの値も設定しておけるnew()
sub new {
    my $class = shift;
    my $self = {};
    bless( $self, $class );
    $self->{ATTRIBUTE_1} = 'default';
    my %hash = @_;
    foreach $key ( keys( %hash ) ) {
        $self->{ $key } = %hash{ $key }
    }
    return $self;
}

継承をできるようにしたnew()
sub new {
    my $class = shift;
    my $self = {};
    bless( $self, $class );
    return $self;
}
        利用法(子クラス)
        use ParentClass;
        @ISA = qw( ParentClass );
        利用法(プログラム本体)
        use ChildClass;
        $object = ChildClass->new();

クローニングのできるnew()
sub new {
    my $param = shift;
    my $class = ref( $param ) || $param;
    my $self = {};
    bless( $self, $class );
    return $self;
}
        利用法
        use Class;
        $object1 = new Class;
        $object2 = $object1->new();

package CGI;
sub new {
    my($class,$initializer) = @_;
    my $self = {};
    bless $self,ref $class || $class || $DefaultClass;
    $CGI::DefaultClass->_reset_globals() if $MOD_PERL;
    $initializer = to_filehandle($initializer) if $initializer;
    $self->init($initializer);
    return $self;
}

package CGI::Fast;
sub new {
    return undef unless FCGI::accept() >= 0;
    my($self,@param) = @_;
    return $CGI::Q = $self->SUPER::new(@param);
}

package CGI::Switch;

sub new {
    shift;
    my($file,$pack);
    for $pack (@Pref) {
        ($file = $pack) =~ s|::|/|g;
        eval { require "$file.pm"; };
        if ($@) {
#XXX        warn $@;
            next;
        } else {
#XXX        warn "Going to try $pack\->new\n";
            my $obj;
            eval {$obj = $pack->new(@_)};
            if ($@) {
#XXX            warn $@;
            } else {
                return $obj;
            }
        }
    }
    Carp::croak "Couldn't load+construct any of @Pref\n";
}


package Class::Struct;

    $out = "{\n  package $class;\n  use Carp;\n  sub new {\n";

    my $cnt = 0;
    my $idx = 0;
    my( $cmt, $name, $type, $elem );

    if( $base_type eq 'HASH' ){
        $out .= "    my(\$r) = {};\n";
        $cmt = '';
    }
    elsif( $base_type eq 'ARRAY' ){
        $out .= "    my(\$r) = [];\n";
    }

package CPAN;
sub new {
    bless {}, shift;
}

package CPAN::Mirrored::By;
sub new {
    my($self,@arg) = @_;
    bless [@arg], $self;
}

package DirHandle;
sub new {
    @_ >= 1 && @_ <= 2 or croak 'usage: new DirHandle [DIRNAME]';
    my $class = shift;
    my $dh = gensym;
    if (@_) {
        DirHandle::open($dh, $_[0])
            or return undef;
    }
    bless $dh, $class;
}

package ExtUtils::Install::Warn;
sub new { bless {}, shift }

package I18N::Collate;
sub new {
  my $new = $_[1];
  if ($^W && $] >= 5.003_06) {
    unless ($please_use_I18N_Collate_even_if_deprecated) {
      warn <<___EOD___;
***

  WARNING: starting from the Perl version 5.003_06
  the I18N::Collate interface for comparing 8-bit scalar data
  according to the current locale

        HAS BEEN DEPRECATED

  That is, please do not use it anymore for any new applications
  and please migrate the old applications away from it because its
  functionality was integrated into the Perl core language in the
  release 5.003_06.

  See the perllocale manual page for further information.

***
___EOD___
      $please_use_I18N_Collate_even_if_deprecated++;
    }
  }

  bless \$new;
}