view release on metacpan or  search on metacpan

lib/Action/Retry.pm  view on Meta::CPAN

}

# ABSTRACT: Module to try to perform an action, with various ways of retrying and sleeping between retries.

use Module::Runtime qw(use_module);
use Scalar::Util qw(blessed);
use Time::HiRes qw(usleep gettimeofday);
use Carp;

use base 'Exporter';
our @EXPORT_OK = qw(retry);

lib/Action/Retry.pm  view on Meta::CPAN

has strategy => (
    is => 'ro',
    default => sub { 'Constant' },
    coerce => sub {
        my $attr = $_[0];
        blessed($attr)
          and return $attr;
        my $class_name = $attr;
        my $constructor_params = {};
        if (ref $attr eq 'HASH') {
            $class_name = (keys %$attr)[0];

 view release on metacpan or  search on metacpan

lib/Activator/Config.pm  view on Meta::CPAN

=cut

sub new {
    my ( $pkg ) = @_;

    my $self = bless( {
		       REGISTRY   => Activator::Registry->new(),
		       ARGV_EXTRA => {},
		       ARGV       => undef,
		       BAREWORDS  => undef,
		      }, $pkg);

 view release on metacpan or  search on metacpan

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

our $VERSION = '1.11';

use utf8;
use Carp;
use Scalar::Util qw/blessed/;

use ActiveRecord::Simple::QueryManager;
use ActiveRecord::Simple::Utils qw/all_blessed class_to_table_name load_module/;
use ActiveRecord::Simple::Connect;

our $connector;
my $qm = ActiveRecord::Simple::QueryManager->new();

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

    my $params = (scalar @_ > 1) ? {@_} : $_[0];

    # relations
    $class->_init_relations if $class->can('_get_relations');

    return bless $params || {}, $class;
}

sub auto_load {
   my ($class) = @_;

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

### Private

sub _get_primary_key_value {
    my ($self) = @_;

    croak "Sory, you can call method '_get_primary_key_value' on unblessed scalar."
        unless blessed $self;

    my $pk = $self->_get_primary_key;
    return $self->$pk;
}

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

        if (grep { $full_relation_type eq $_ } qw/one_to_many one_to_one one_to_only/) {
            *{$pkg_method_name} = sub {
                my ($self, @args) = @_;
                if (@args) {
                    my $object = shift @args;
                    croak "Using unblessed scalar as an object reference"
                        unless blessed $object;

                    $object->save() if ! exists $object->{isin_database} && !$object->{isin_database} == 1;

                    #$self->$fk($object->$pk);
                    $self->{$fk} = $object->{$pk};

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

        elsif ($full_relation_type eq 'many_to_one') {
            *{$pkg_method_name} = sub {
                my ($self, @args) = @_;

                if (@args) {
                    unless (all_blessed(\@args)) {
                        return $related_class->find(@args)->left_join($self->_get_table_name);
                    }

                    OBJECT:
                    for my $object (@args) {
                        next OBJECT if !blessed $object;

                        my $pk = $self->_get_primary_key;
                        #$object->$fk($self->$pk)->save;
                        $object->{$fk} = $self->{$pk};
                        $object->save();

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

                if (@args) {

                    my $related_subclass = _get_related_subclass($relation);

                    unless (all_blessed(\@args)) {
                        return  $related_class->_find_many_to_many({
                            root_class => $class,
                            via_table  => $relation->{via_table},
                            m_class    => $related_subclass,
                            self       => $self,

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

                        defined $pk1 or croak 'You are trying to create relations between unsaved objects. Save your ' . $class . ' object first';

                        OBJECT:
                        for my $object (@args) {
                            next OBJECT if !blessed $object;

                            my $pk2_name = $object->_get_primary_key;
                            my $pk2 = $object->{$pk2_name};

                            $related_subclass->new($fk1 => $pk1, $fk2 => $pk2)->save;

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

                        my $via_table = $relation->{via_table};

                        OBJECT:
                        for my $object (@args) {
                            next OBJECT if !blessed $object;

                            my $pk2_name = $object->_get_primary_key;
                            my $pk2 = $object->{$pk2_name};

                            my $sql = qq/INSERT INTO "$via_table" ("$fk1", "$fk2") VALUES (?, ?)/;

lib/ActiveRecord/Simple.pm  view on Meta::CPAN

    $user->update({ last_login => \'NOW()' });


=head2 to_hash

Unbless object, get naked hash


=head2 increment

Increment fields

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$args{path}  =~ s!::!/!g;
	}
	$args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;

 view release on metacpan or  search on metacpan

lib/Adam.pm  view on Meta::CPAN

    $self->debug( join ' ', @output );
    return 0;
}

sub run {
    $_[0]->new_with_options unless blessed $_[0];
    POE::Kernel->run;
}


has _loop => (

lib/Adam.pm  view on Meta::CPAN

);

sub async {
    my $self = shift;
    require IO::Async::Loop::POE;
    $self = $self->new_with_options unless blessed $self;
    my $loop = IO::Async::Loop::POE->new();
    $self->_loop($loop);
    $loop->run;
}

 view release on metacpan or  search on metacpan

lib/Adapter/Async.pm  view on Meta::CPAN

=cut

sub new {
	my $class = shift;
	bless { @_ }, $class
}

=head2 bus

Accessor for the L<Adapter::Async::Bus> instance, will create one as

 view release on metacpan or  search on metacpan

lib/AddressBook.pm  view on Meta::CPAN

						 );
    };
    croak "Couldn't load backend `$driverName': $@" if $@;
    $self->{db_name}=$type;
  } else {
    bless ($self,$class);
  }
  return $self;
}

=head2 sync

 view release on metacpan or  search on metacpan

Config.pm  view on Meta::CPAN

   my $class = ref ( $prototype ) || $prototype;
   my $self = {};

   # Create an empty object ...
   bless ( $self, $class );

   # Creating a new object ... (The main section)
   my %control;

   # Initialize what options were selected ...

Config.pm  view on Meta::CPAN

   my $class = ref ( $prototype ) || $prototype;
   my $self  = {};

   # Create an empty object ...
   bless ( $self, $class );

   if ( ref ( $parent ) ne __PACKAGE__ ) {
      die ("You must provide an ", __PACKAGE__, " object as an argument!\n");
   }

 view release on metacpan or  search on metacpan

Infix2Postfix.pm  view on Meta::CPAN

    $self->{'numre'}='[+-]?(?:\d+\.?\d*|\.\d+)(?:[eE][+-]?\d+)?';

    $self->{'re'}=join('|',(map { quotemeta($_).'(?!'.quotemeta($_).')' } @{$self->{'tokens'}}),$self->{'numre'});
    $self->{'ree'}=$self->{'re'}.'|.+?';
    $self->{ERRSTR}='';
    bless $self,$class;
    return $self;
}

sub tokenize {
    my $self=shift;

 view release on metacpan or  search on metacpan

builder/Affix/Builder.pm  view on Meta::CPAN

        }
        $meta->save(@$_) for ['MYMETA.json'];
    }

    sub find ( $pattern, $base ) {
        $base = path($base) unless builtin::blessed $base;
        my $blah = $base->visit(
            sub ( $path, $state ) {
                $state->{$path} = $path if $path =~ $pattern;
            },
            { recurse => 1 }

 view release on metacpan or  search on metacpan

lib/Agent/TCLI/Control.pm  view on Meta::CPAN

#				{
#					$txt .= "$attr: ".$self->$attr." \n";
#					$code = 200;
#				}
#				# is it an object and show_method is defined?.
#				elsif ( $ref =~ qr(::) && blessed( $self->$attr )
#					&& $show )
#				{
#					$txt .= "$attr: ".$self->$attr->$show."\n";
#					$code = 200;
#				}
#				# is it an object with dump? Probably OIO.
#				elsif ( $ref =~ qr(::) && blessed($self->$attr)
#					&& $self->$attr->can( 'dump') )
#				{
#					$var = $self->$attr->dump(0);
#					$txt .= Dump($var)."\n";
#					$code = 200;

lib/Agent/TCLI/Control.pm  view on Meta::CPAN

#							$txt .= "$attr ->{ $key }: ".$self->$attr->{$key}." \n";
#							$code = 200;
#						}
#						# is it an object and show_method is defined?.
#						elsif ( $subref =~ qr(::) &&
#							blessed($self->$attr->{ $key }) &&
#							defined($show) )
#						{
#							$txt .= "$attr: ".$self->$attr->{$key}->$show."\n";
#							$code = 200;
#						}
#						# is it an object with dump? Probably OIO.
#						elsif ( $subref =~ qr(::) &&
#							blessed($self->$attr->{ $key }) &&
#							$self->$attr->{ $key }->can( 'dump') )
#						{
#							$var = $self->$attr->{$key}->dump(0);
#							$txt .= Dump($var)."\n";
#							$code = 200;

lib/Agent/TCLI/Control.pm  view on Meta::CPAN

#							$txt .= "$attr ->[ $i ]: ".$val." \n";
#							$code = 200;
#						}
#						# is it an object and show_method is defined?.
#						elsif ( $subref =~ qr(::) &&
#							blessed($val) &&
#							defined($show) )
#						{
#							$txt .= "$attr: ".$val->$show."\n";
#							$code = 200;
#						}
#						# is it an object with dump? Probably OIO.
#						elsif ( $subref =~ qr(::) &&
#							blessed($val) &&
#							$val->can( 'dump') )
#						{
#							$var = $val->dump(0);
#							$txt .= Dump($var)."\n";
#							$code = 200;

 view release on metacpan or  search on metacpan

Agent.pm  view on Meta::CPAN

			my $agentclass = $tom->class;
			my $str =
			   "if ('$agentclass' && (\${$agentclass\:\:}{new})) {\n" .
			   "   \$agent = new $agentclass(" . %args . ");\n" .
			   "} else {\n" .
			   "   \$agent = {}; bless \$agent, $agentclass;\n" .
			   "}";

			$cpt->reval($str);
			print "AGENT: ", ${$cpt->varglob('agent')}, "\n";

Agent.pm  view on Meta::CPAN

				return;
			}
		}
		# store the agent's class in the agent itself:
		${$cpt->varglob($self->{AgentVar})}->{Tom} = $tom;
		bless $self, $class;	# bless wrapper into Agent!
	} else {
		unless ($self = $tom->get_object) {
			no strict;
			# got no object, so create one:
			my $agentclass = $tom->class();
			if (($agentclass) && (${"$agentclass\:\:"}{new})) {
				$self = new $agentclass(%args);
			} else {
				print STDERR "$agentclass\:\:new() not found!\n" if $Debug;
				# we'll just bless $self into the agent's class:
				$self = {};
				bless $self, $agentclass;
			}
		}
		# store the agent's class in the agent itself:
		$self->{Tom} = $tom;
	}
	# this is not true for wrapped agents:
	print "agent's class is: " . ref($self) . "\n" if $Debug > 1;

	return $self;	# blessed into owning agent's class!
}


##
# Inherited methods safe for use by agent objects.

 view release on metacpan or  search on metacpan

lib/Aion/Carp.pm  view on Meta::CPAN

=head1 DESCRIPTION

This module replaces C<$SIG{__DIE__}> with a function that adds a stack trace to exceptions.

If the exception is a string, a stack trace is added to the message. And if the exception is a hash (C<{}>) or a hash-based object (C<bless {}, "..."), then the>STACKTRACE` key with stacktrace is added to it.

When the exception is thrown again, the stack trace is not added, but remains the same.

=head1 SUBROUTINES

 view release on metacpan or  search on metacpan

lib/Aion/Enum.pm  view on Meta::CPAN

	$issa->{name}->validate($name, "$name name") if $issa->{name};
	$issa->{value}->validate($value, "$name value") if $issa->{value};
	$issa->{stash}->validate($stash, "$name stash") if $issa->{stash};
	$issa->{alias}->validate($pkg->_alias->{$name}, "$name alias") if $issa->{alias};
	
	my $case = bless {
        name => $name,
        defined($value)? (value => $value): (),
        defined($stash)? (stash => $stash): (),
    }, $pkg;

 view release on metacpan or  search on metacpan

lib/Aion/Fs.pm  view on Meta::CPAN

	my $ex = @_ && ref($_[$#_]) eq 'Aion::Fs::Find'
		? pop
		: undef;

	if($ex) {
		bless $ex, 'Aion::Fs';
		if(Scalar::Util::reftype $ex eq 'CODE') {
			$errorenter = $ex;
		} else {
			$errorenter = bless pop @$ex, undef if Scalar::Util::reftype($ex->[$#$ex]) eq "CODE";
			push @noenters, _filters @$ex;
		}
	}
	
	my @filters = _filters @_;

lib/Aion/Fs.pm  view on Meta::CPAN

		: do { while(defined $iter->next) {} };
}

# Не входить в подкаталоги
sub noenter(@) {
	bless [@_], "Aion::Fs::Find"
}

# Вызывается для всех ошибок ввода-вывода
sub errorenter(&) {
	bless shift, "Aion::Fs::Find"
}

# Останавливает find будучи вызван с одного из его фильтров, errorenter или noenter
sub find_stop() {
	die bless \(my $stop = 1), "Aion::Fs::Find"
}

# Производит замену во всех указанных файлах. Возвращает файлы в которых замен не было
sub replace(&@) {
    my $fn = shift;

lib/Aion/Fs.pm  view on Meta::CPAN

Connects C<$pkg> (if it has not already been connected via C<use> or C<require>) and returns it. Without a parameter, uses C<$_>.

lib/A.pm file:

	package A;
	sub new { bless {@_}, shift }
	1;

lib/N.pm file:

	package N;

 view release on metacpan or  search on metacpan

lib/Aion/Query.pm  view on Meta::CPAN

	ref $k eq "HASH"?
		join(", ", map { join "", $_, " = ", quote $k->{$_} } sort keys %$k):
	ref $k eq "REF" && ref $$k eq "ARRAY"?
		join(" ", List::Util::pairmap { join " ", "WHEN", quote $a, "THEN", quote $b } @$$k):
	ref $k eq "SCALAR"? $$k:
	Scalar::Util::blessed $k ? $k:
	ref $k ne ""? die "Something strange: `$k`":
	$k =~ /^-?(?:0|[1-9]\d*)(\.\d+)?\z/a
		&& ($ref = ref B::svref_2object(@_ == 0? \$_: \$_[0])
		) ne "B::PV"? (
			!$1 && $ref eq "B::NV"? "$k.0": $k

lib/Aion/Query.pm  view on Meta::CPAN

		}
	}

	$Aion::Query::base->begin_work;

	bless {}, 'Aion::Query::Transaction';
}

1;

__END__

 view release on metacpan or  search on metacpan

lib/Aion/Telemetry.pm  view on Meta::CPAN

	$REFMARKS[$#REFMARKS]->{interval} += $now - $REFMARK_LAST_TIME if @REFMARKS;
	$REFMARK_LAST_TIME = $now;

	push @REFMARKS, $REFMARK{$mark} //= {mark => $mark};

	bless \$mark, 'Aion::Refmark'
}

# Создаёт отчёт по реперным точкам
sub refreport(;$) {
	my ($clean) = @_;

 view release on metacpan or  search on metacpan

lib/Aion.pm  view on Meta::CPAN

	my $new = << 'END';
package %(cls)s {
	sub new {
		my ($cls, %value) = @_;
		$cls = ref $cls || $cls;
		my $self = bless {}, $cls;
		
%(initializers)s
		
		if(scalar keys %value) {
			my @fakekeys = sort keys %value;

lib/Aion.pm  view on Meta::CPAN

	}
	
	package ExIsa { use Aion;
		has x => (isa => Int);
		has y => (isa => sub { /^\d+$/ });
		has z => (isa => bless({}, 'Externalis'), coerce => 1);
	}
	
	ExIsa->new(x => 'str') # @-> Set feature x must have the type Int. The it is 'str'!
	ExIsa->new->x # @-> Get feature x must have the type Int. The it is undef!
	ExIsa->new(x => 10)->x			  # -> 10

 view release on metacpan or  search on metacpan

lib/Akado/Account.pm  view on Meta::CPAN

    croak 'No login specified, stopped' unless $self->{login};
    croak 'No password specified, stopped' unless $self->{password};

    $self->{site} ||= 'https://office.akado.ru/';

    bless($self, $class);
    return $self;
}


sub get_balance {

 view release on metacpan or  search on metacpan

lib/Akamai/PropertyFetcher.pm  view on Meta::CPAN

our $VERSION = '0.01';

sub new {
    my ($class, %args) = @_;
    my $self = bless {}, $class;

    $self->{agent} = Akamai::Edgegrid->new(
        config_file => $args{config_file} || "$ENV{HOME}/.edgerc",
        section     => $args{section} || "default"
    );

 view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

	# Actualize.
	$self->{file_size} = $st[7];
	$self->{timestamp} = $st[9];
    }

    bless($self, $pkg);
}

INIT {
    no strict 'refs';
    for my $sub ( @std_fields, @exif_fields ) {

script/album  view on Meta::CPAN

use constant CACHE_VERSION => 3;

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) || $pkg;
    my $self = bless({}, $pkg);
    if ( defined($file) ) {
	$self->load($file);
	if ( ($self->{_version} || 1) != CACHE_VERSION ) {
	    warn("Incompatible cache version " . $self->version .
		 " -- invalidated\n") if $verbose;
	    $self = bless({}, $pkg);
	}
    }
    $self->{_version} = CACHE_VERSION;
    $self;
}

 view release on metacpan or  search on metacpan

lib/Algorithm/AM/DataSet.pm  view on Meta::CPAN

sub new {
    my ($class, %opts) = @_;

    my $new_opts = _check_opts(%opts);

    my $self = bless $new_opts, $class;

    $self->_init;

    return $self;
}

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

        $args{path}  = $args{name};
        $args{path}  =~ s!::!/!g;
    }
    $args{file}     ||= "$args{prefix}/$args{path}.pm";

    bless(\%args, $class);
}

#line 210

sub call {

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		$args{path}  =~ s!::!/!g;
	}
	$args{file}     ||= "$args{base}/$args{prefix}/$args{path}.pm";
	$args{wrote}      = 0;

	bless( \%args, $class );
}

sub call {
	my ($self, $method) = @_;
	my $obj = $self->load($method) or return;

 view release on metacpan or  search on metacpan

perlobject.map  view on Meta::CPAN

# "perlobject.map"  Dean Roehrich, version 19960302
#
# TYPEMAPs
#
# HV *    -> unblessed Perl HV object.
# AV *    -> unblessed Perl AV object.
#
# INPUT/OUTPUT maps
#
# O_*   -> opaque blessed objects
# T_*   -> opaque blessed or unblessed objects
#
# O_OBJECT  -> link an opaque C or C++ object to a blessed Perl object.
# T_OBJECT  -> link an opaque C or C++ object to an unblessed Perl object.
# O_HvRV  -> a blessed Perl HV object.
# T_HvRV  -> an unblessed Perl HV object.
# O_AvRV  -> a blessed Perl AV object.
# T_AvRV  -> an unblessed Perl AV object.

TYPEMAP

HV *    T_HvRV
AV *    T_AvRV


######################################################################
OUTPUT

# The Perl object is blessed into 'CLASS', which should be a
# char* having the name of the package for the blessing.
O_OBJECT
  sv_setref_pv( $arg, CLASS, (void*)$var );

T_OBJECT
  sv_setref_pv( $arg, Nullch, (void*)$var );

# Cannot use sv_setref_pv() because that will destroy
# the HV-ness of the object.  Remember that newRV() will increment
# the refcount.
O_HvRV
  $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );

T_HvRV
  $arg = newRV((SV*)$var);

# Cannot use sv_setref_pv() because that will destroy
# the AV-ness of the object.  Remember that newRV() will increment
# the refcount.
O_AvRV
  $arg = sv_bless( newRV((SV*)$var), gv_stashpv(CLASS,1) );

T_AvRV
  $arg = newRV((SV*)$var);

perlobject.map  view on Meta::CPAN

O_OBJECT
  if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
    $var = ($type)SvIV((SV*)SvRV( $arg ));
  else{
    warn( \"${Package}::$func_name() -- $var is not a blessed SV reference\" );
    XSRETURN_UNDEF;
  }

T_OBJECT
  if( SvROK($arg) )

perlobject.map  view on Meta::CPAN

O_HvRV
  if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )
    $var = (HV*)SvRV( $arg );
  else {
    warn( \"${Package}::$func_name() -- $var is not a blessed HV reference\" );
    XSRETURN_UNDEF;
  }

T_HvRV
  if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVHV) )

perlobject.map  view on Meta::CPAN

O_AvRV
  if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )
    $var = (AV*)SvRV( $arg );
  else {
    warn( \"${Package}::$func_name() -- $var is not a blessed AV reference\" );
    XSRETURN_UNDEF;
  }

T_AvRV
  if( SvROK($arg) && (SvTYPE(SvRV($arg)) == SVt_PVAV) )

 view release on metacpan or  search on metacpan

lib/Algorithm/AhoCorasick/SearchMachine.pm  view on Meta::CPAN

	$keywords{$_} = 1;
    }

    my $self = { keywords => [ keys %keywords ] };
    bless $self, $class;
    $self->_build_tree();
    return $self;
}

sub _build_tree {

lib/Algorithm/AhoCorasick/SearchMachine.pm  view on Meta::CPAN

    my $self = { @_ };
    $self->{results} = { };
    $self->{transitions} = { };
    weaken $self->{parent} if $self->{parent};
    return bless $self, $class;
}

sub char {
    my $self = shift;

 view release on metacpan or  search on metacpan

Annotate.pm  view on Meta::CPAN

=cut

sub new {
    my $class = shift;
    my $self = bless {}, $class;
    return $self;
}

sub init {
    my ($self, $info, $seq) = @_;

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

sv_2uv_flags||5.009001|
sv_2uv|5.004000||p
sv_add_arena|||
sv_add_backref|||
sv_backoff|||n
sv_bless|||
sv_buf_to_ro|||
sv_buf_to_rw|||
sv_cat_decode||5.008001|
sv_catpv_flags||5.013006|
sv_catpv_mg|5.004050||p

 view release on metacpan or  search on metacpan

lib/Algorithm/Backoff.pm  view on Meta::CPAN

            $args{$attr} //= $attrspec->{$attr}{default};
        }
    }
    $args{_attempts} = 0;
    $args{_start_timestamp} //= time();
    bless \%args, $class;
}

sub _consider_actual_delay {
    my ($self, $delay, $timestamp) = @_;

 view release on metacpan or  search on metacpan

lib/Algorithm/BaumWelch.pm  view on Meta::CPAN

use version; our $VERSION = qv('0.0.2');

#r/ matrices de BW sao 1xN_states matrices - quer dizer quasi arrays - entao nao usa matrices reais. arrays são bastante
sub new {
    my $class = shift;
    my $self = [undef, undef, []]; bless $self, $class;
    return $self;
}

sub feed_obs {
    my ($self, $series) = @_;