view release on metacpan or  search on metacpan

lib/AutoCode/AccessorMaker.pm  view on Meta::CPAN

        return @$scalar;
    }elsif($ref eq ''){
        return ($scalar);
    }else{
        $class->throw("ref [$ref] is neither nothing nor ARRAY");
    }
}

# This method is only invoked by make_scalar_accessor and make_array_accessor
# While subroutine defined the argument of those two method abovementioned.
# This most hacky part is caller(2); that mean the first immedicate package
# after this Module.
sub __accessor_to_glob {
    my ($self, $accessor, $pkg)=@_;
    defined $accessor or $self->throw("method_name needed as 2nd arg");
    my $singular = (ref($accessor) eq 'ARRAY')? $accessor->[0]: $accessor;
    # According to the specification of AutoCode, upper letter are not allowed
    # in the names of methods which are automatically generated by this system.
    $self->throw("'$singular' method name must match /^$VALID_ACCESSOR_NAME\$/")
        unless $singular =~ /^$VALID_ACCESSOR_NAME$/;
    if(0){ # For debug
        print "$_\t". (caller($_))[0]."\n" foreach(0..3);
        $self->throw("");
    }
    $pkg ||= (caller(2))[0];   # This line will definitely assign a value.

    # This typeglob is meaningful for both scalar and array accessors.
    # For scalar, it means the same as the real typeglob;
    # for array, there is no such method with exact method, but a symbol for
    # these three methods.
    my $typeglob="$pkg\::$singular";
    unless(grep {$_ eq $typeglob} keys %AUTO_ACCESSORS){
        # push @{$self->{AUTO_ACCESSORS_SLOT}}, $typeglob;
        $AUTO_ACCESSORS{$typeglob}=1;
    }

lib/AutoCode/Root0.pm  view on Meta::CPAN

        $out.= "STACK $function $file:$position\n";
    } @stack;
    return $out;
}

sub stack_trace {
    my $self=shift;
    my $i=0;
    my @out=();
    my $prev=[];
    while(my @call=caller($i++)){
        $prev->[3]=$call[3];
        push(@out, $prev);
        $prev=\@call;
    }
    $prev->[3]='toplevel';
    push @out, $prev;
    return @out;
}

sub _not_implemented_msg {
    my $self=shift;
    my $pkg=ref $self;
    my $method=(caller(1))[3];
    my $msg="Abstract method [$method] is not implemented by package $pkg.\n";
    return $msg;
}

sub throw_not_implemented {
    my $self=shift;
    $self->throw($self->_not_implemented_msg);
}

sub warn_not_implemented {