view release on metacpan or  search on metacpan

lib/Tie/Counter.pm  view on Meta::CPAN

sub TIESCALAR {
    my $class     =   shift;
    my $value     =   shift;  #  ?? 0;  # Would have been nice....
       $value     =   0 unless defined $value;
    bless \$value => $class;
}

sub FETCH     {
    ${+shift} ++;
}

 view release on metacpan or  search on metacpan

lib/Tie/FlipFlop.pm  view on Meta::CPAN

sub TIESCALAR {
    my $class = shift;
    do {require Carp;
        Carp::croak ("Incorrect number of arguments");
    } unless 2 == @_;
    bless [reverse @_] => $class;
}

sub FETCH     {
    my $state = shift;
     (@$state = reverse @$state) [0]

 view release on metacpan or  search on metacpan

Google.pm  view on Meta::CPAN

# results are keyed by query.
# ----------------------------------------------------------------------
sub new {
    my ($class, $type, $KEY, $query, $options) = @_;
    $options = { } unless defined $options && ref($options) eq 'HASH';
    my $self = bless [ $KEY, $type, $query, $options, { }, undef, ] => $class;

    # Is $KEY actually a file?
    # I do this in DBD::google as well; perhaps there I should submit
    # a patch to Aaron so that Net::Google can do this directly.
    if (-e $KEY) {

 view release on metacpan or  search on metacpan

Persistent.pm  view on Meta::CPAN

# main workhorse
#
sub _new {
  my ($class, $type, $file, $mode, $other) = @_;
  my $self = [];
  bless $self => $class;
  $mode = lc($mode);
  $self->[1]  = $type;		# keep for easier DESTROY
  $self->[2]  = $file;		# must be given
  $self->[3]  = $mode || 'r';	# mode defaults to read-only
  $self->[4]  = $Autosync;      # default to global

 view release on metacpan or  search on metacpan

lib/Tie/Pick.pm  view on Meta::CPAN

sub TIESCALAR {
    my $class  =   shift;
    do { require Carp;
         Carp::croak ("tie needs more arguments")
    } unless @_;
    bless [@_] => $class;
}

sub FETCH     {
    my $values = shift;
    return undef unless @$values;

 view release on metacpan or  search on metacpan

lib/Tie/Reduce.pm  view on Meta::CPAN

	no warnings 'uninitialized';
	if (ref($coderef) ne 'CODE') {
		require Carp;
		Carp::croak("Expected coderef; got $coderef");
	}
	bless [$initial_value, $coderef] => $class;
}

sub get_value {
	$_[0][0];
}

 view release on metacpan or  search on metacpan

lib/Tie/SaveLater.pm  view on Meta::CPAN

	    if $types2check{$type} and !$self->isa($type);
    }else{
	$self = 
	    { HASH => {}, ARRAY => [], SCALAR => \do{ my $scalar }}->{$type};
    }
    bless $self => $class.'::'.$type;
    $DEBUG and carp sprintf("tied $filename => 0x%x", 0+$self);
    @_ and $self->options(@_);
    $self->_regobj($filename);
    $self;
}

 view release on metacpan or  search on metacpan

lib/Tie/Symbol.pm  view on Meta::CPAN

    my $classname = ref $class || $class;

    my $self = { ns => "$namespace", };

    bless $self => $classname;
}

sub FETCH {
    my ( $self, $name, $force ) = @_;
    return $self->{$name} if ( not $force and scalar caller eq __PACKAGE__ );

 view release on metacpan or  search on metacpan

lib/Time/Duration/Object.pm  view on Meta::CPAN

#pod =cut

sub new {
	my ($class, $duration) = @_;
	return unless defined $duration;
	bless \$duration => $class;
}

#pod =head2 C< seconds >
#pod
#pod This returns the number of seconds in the duration (i.e., the argument you

 view release on metacpan or  search on metacpan

lib/Time/Strptime/TimeZone.pm  view on Meta::CPAN

sub new {
    my ($class, $name) = @_;
    $name ||= $DEFAULT;
    my $tz = blessed $name && $name->isa('DateTime::TimeZone') ? $name : DateTime::TimeZone->new(name => $name);
    return bless [$tz, 0] => $class;
}

sub name { $_[0]->[0]->name }

sub local_rd_as_seconds { $_[0]->[1] + UNIX_EPOCH }

 view release on metacpan or  search on metacpan

CursorControl.pm  view on Meta::CPAN

sub new {
  my ( $me, $parent ) = @_;
  my $class = ref($me) || $me;
  my $self = {};
  bless $self => $class;

  # provide access to class data
  $self->{_Init}       = \$AlreadyInit;
  $self->{_CurrentObj} = \$CurrentObject;

 view release on metacpan or  search on metacpan

MDI/ChildWindow.pm  view on Meta::CPAN

sub new {
	my $self  = shift;
	my $class = ref($self) || $self;

	my $obj = bless {} => $class;

	my %args  = @_;
	$obj->{PARENT}    = delete $args{-parent} or die "No Parent Frame";
	$obj->{PARENTOBJ} = delete $args{-parentobj} or die "No Parent Object";
	$obj->{NAME}     = $args{-name};

 view release on metacpan or  search on metacpan

lib/Tree/RB.pm  view on Meta::CPAN

    if($cmp) {
        ref $cmp eq 'CODE'
          or croak('Invalid arg: codref expected');
        $obj->[CMP] = $cmp;
    }
    return bless $obj => $class;
}

*TIEHASH = \&new;

sub DESTROY { $_[0]->[ROOT]->DESTROY if $_[0]->[ROOT] }

 view release on metacpan or  search on metacpan

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

sub _new {
    my $class = shift;
    my $opts = { @_ };

	my $this = bless [] => $class;

	$this->[INTEREST]       = $opts->{interest};
	$this->[TRACK]          = $opts->{track};
	$this->[FILTER_TEXT]    = $opts->{filter_text};
	$this->[FILTER_COMMENT] = $opts->{filter_comment};

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

};

sub _new {
    my $class = shift;

    my $this = bless [] => $class;
    $this->[IN] = [];
    $this->[ADDED] = [];
    $this->[DELETED] = undef;
    $this->[CURRENT] = undef; # Tripletail::HtmlFilter::{Element,Comment,Text}

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

    if (ref $name) {
		die __PACKAGE__."#_new, ARG[1] was bad Ref. [$name]\n";
    }

    my $this = bless [] => $class;
    $this->[NAME] = $name;
    $this->[ATTRS] = []; # [[key, val], [key, val], ...]
    $this->[ATTR_H] = {}; # key => [key, val] ($this->[ATTRS]の要素と共有)
    $this->[TAIL] = undef;

ext/Tripletail-HtmlFilter/HtmlFilter.pm  view on Meta::CPAN

sub _new {
    my $class = shift;
    my $str = shift;

    my $this = bless [] => $class;
    $this->[STR] = $str;

    $this;
}

 view release on metacpan or  search on metacpan

lib/Type/Nano.pm  view on Meta::CPAN

	"UNIVERSAL"->can("DOES") ? $proto->SUPER::DOES(@_) : $proto->isa(@_);
}

sub new { # Type::API::Constraint::Constructor
	my $class = ref($_[0]) ? ref(shift) : shift;
	my $self  = bless { @_ == 1 ? %{+shift} : @_ } => $class;
	
	$self->{constraint} ||= sub { !!1 };
	unless ($self->{name}) {
		require Carp;
		Carp::croak("Requires both `name` and `constraint`");

 view release on metacpan or  search on metacpan

lib/Type/Nano.pm  view on Meta::CPAN

	"UNIVERSAL"->can("DOES") ? $proto->SUPER::DOES(@_) : $proto->isa(@_);
}

sub new { # Type::API::Constraint::Constructor
	my $class = ref($_[0]) ? ref(shift) : shift;
	my $self  = bless { @_ == 1 ? %{+shift} : @_ } => $class;
	
	$self->{constraint} ||= sub { !!1 };
	unless ($self->{name}) {
		require Carp;
		Carp::croak("Requires both `name` and `constraint`");

 view release on metacpan or  search on metacpan

lib/Eval/TypeTiny.pm  view on Meta::CPAN

		Eval::TypeTiny::_TieArray;
	require Tie::Array;
	our @ISA = qw( Tie::StdArray );
	sub TIEARRAY {
		my $class = shift;
		bless $_[0] => $class;
	}
	sub AUTOLOAD {
		my $self = shift;
		my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
		defined tied(@$self) and return tied(@$self)->$method(@_);

lib/Eval/TypeTiny.pm  view on Meta::CPAN

		Eval::TypeTiny::_TieHash;
	require Tie::Hash;
	our @ISA = qw( Tie::StdHash );
	sub TIEHASH {
		my $class = shift;
		bless $_[0] => $class;
	}
	sub AUTOLOAD {
		my $self = shift;
		my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
		defined tied(%$self) and return tied(%$self)->$method(@_);

lib/Eval/TypeTiny.pm  view on Meta::CPAN

		Eval::TypeTiny::_TieScalar;
	require Tie::Scalar;
	our @ISA = qw( Tie::StdScalar );
	sub TIESCALAR {
		my $class = shift;
		bless $_[0] => $class;
	}
	sub AUTOLOAD {
		my $self = shift;
		my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
		defined tied($$self) and return tied($$self)->$method(@_);

 view release on metacpan or  search on metacpan

lib/UNIVERSAL/Object.pm  view on Meta::CPAN

    Carp::confess('CREATE must return a reference to bless, not '.$instance)
        unless defined $instance && ref $instance;

    my $repr = ref   $instance;
    my $self = bless $instance => $class;

    # So,... for HASH based instances we'll
    # lock the set of keys so as to prevent
    # typos and other such silliness, if
    # you use other $repr types, you are

 view release on metacpan or  search on metacpan

lib/UR/Object/Type/Initializer.pm  view on Meta::CPAN

    # only do this when the classes match
    # when they do not match, the super-class has already called this by delegating to the correct subclass
    $class_name::VERSION = 2.0; # No BumpVersion

    my $self =  bless { id => $class_name, %$desc }, $meta_class_name;

    $UR::Context::all_objects_loaded->{$meta_class_name}{$class_name} = $self;
    my $full_name = join( '::', $class_name, '__meta__' );
    Sub::Install::reinstall_sub({
        into => $class_name,

 view release on metacpan or  search on metacpan

lib/URI/Nested.pm  view on Meta::CPAN

    $uri->scheme($scheme) if $scheme && !$uri->scheme;
    if ( my $nested_class = $class->nested_class ) {
        bless $uri => $nested_class unless $uri->isa($nested_class);
    }

    bless [ $prefix => $uri ] => $class;
}

sub new_abs {
    my ($class, $uri, $base) = @_;
    $uri = URI->new($uri);

lib/URI/Nested.pm  view on Meta::CPAN

    my ($class, $scheme, $str) = @_;
    my $uri = URI->new($str);
    if ( my $nested_class = $class->nested_class ) {
        bless $uri => $nested_class unless $uri->isa($nested_class);
    }
    bless [ $scheme, $uri ] => $class;
}

sub nested_uri { shift->[1] }

sub scheme {

 view release on metacpan or  search on metacpan

lib/URI/Template.pm  view on Meta::CPAN

sub new {
    my $class = shift;
    my $templ = shift;
    $templ = '' unless defined $templ;
    my $self  = bless { template => $templ, _vars => {} } => $class;

    $self->_study;

    return $self;
}

 view release on metacpan or  search on metacpan

lib/URI/mssql.pm  view on Meta::CPAN

        :       die "Unknown driver: $driver\n";

    eval "require $class" or die;

    # Make a copy blessed into the alternate class to get its DSN.
    my $alt = bless \"$self" => $class;
    return $alt->dbi_dsn;
}

1;

 view release on metacpan or  search on metacpan

lib/URI/_duri_tdb.pm  view on Meta::CPAN

}

sub _new_from_string
{
	my ($class, $str) = @_;
	my $self = bless \$str => $class;
	$self->_deconstruct;
	return $self;
}

sub _new_from_hashref
{
	my ($class, $hashref) = @_;
	
	my $str  = $class->_preferred_scheme . ':2001:urn:example:1';
	my $self = bless \$str => $class;

	if ($hashref->{datetime_string})
		{ $self->datetime_string($self->{datetime_string}) }
	elsif ($hashref->{datetime})
		{ $self->datetime($self->{datetime}) }

 view release on metacpan or  search on metacpan

lib/Ubic/Service/InitScriptWrapper.pm  view on Meta::CPAN

    unless (-e $init) {
        die "Init script $init not found";
    }

    return bless { init => $init } => $class;
}

sub start_impl {
    my $self = shift;
    system("$self->{init} start >/dev/null");

 view release on metacpan or  search on metacpan

lib/Ubic/Service/Memcached.pm  view on Meta::CPAN

        unless (defined $PID_DIR) {
            croak "pidfile parameter not defined, define it or set /module/Ubic/Service/Memcached/pid_dir configuration option";
        }
        $params->{pidfile} = "$PID_DIR/$params->{port}.pid";
    }
    return bless $params => $class;
}

sub start_impl {
    my $self = shift;

 view release on metacpan or  search on metacpan

lib/Ubic/Service/MongoDB.pm  view on Meta::CPAN

    }
    if (!$params->{gen_cfg}) {
        $params->{gen_cfg} = "/tmp/$self->{daemon}." . $self->{port} . '.conf';
    }

    return bless $params => $class;
}

sub bin {
    my $self = shift;

 view release on metacpan or  search on metacpan

lib/Ubic/Service/Plack.pm  view on Meta::CPAN

        pidfile     => { type => SCALAR, optional => 1 },
        cwd => { type => SCALAR, optional => 1 },
        env => { type => HASHREF, optional => 1 },
    });

    return bless $params => $class;
}

sub pidfile {
    my $self = shift;
    return $self->{pidfile} if defined $self->{pidfile};

 view release on metacpan or  search on metacpan

lib/Ubic/Service/ServerStarter.pm  view on Meta::CPAN

        proxy_logs  => { type => BOOLEAN, optional => 1 },
        pidfile     => { type => SCALAR, optional => 1 },
        cwd         => { type => SCALAR, optional => 1 },
    });

    return bless $params => $class;
}

sub pidfile {
    my ($self) = @_;
    return $self->{pidfile} if defined $self->{pidfile};

 view release on metacpan or  search on metacpan

lib/Ubic/Service/ZooKeeper.pm  view on Meta::CPAN

    }
    if (!$params->{gen_cfg}) {
        $params->{gen_cfg} = catfile('/tmp', 'zoo.' . $clientPort . '.cfg');
    }

    return bless $params => $class;
}


sub bin {
    my $self = shift;

 view release on metacpan or  search on metacpan

lib/Ubic.pm  view on Meta::CPAN

    $self->{status_dir} = "$self->{data_dir}/status";
    $self->{lock_dir} = "$self->{data_dir}/lock";
    $self->{tmp_dir} = "$self->{data_dir}/tmp";

    $self->{service_cache} = {};
    return bless $self => $class;
}

sub start($$) {
    my $self = _obj(shift);
    my ($name) = validate_pos(@_, $validate_service);