Memcached-libmemcached

 view release on metacpan or  search on metacpan

libmemcached.xs  view on Meta::CPAN

void
memcached_free(Memcached__libmemcached ptr)
    INIT:
        if (!ptr)   /* garbage or already freed this sv */
            XSRETURN_EMPTY;
    POSTCALL:
        LMC_STATE_FROM_PTR(ptr)->ptr = NULL;

void
DESTROY(SV *sv)
    PPCODE:
    lmc_state_st *lmc_state;
    lmc_cb_context_st *lmc_cb_context;

    lmc_state = (lmc_state_st*)LMC_STATE_FROM_SV(sv);
    if (lmc_state->trace_level >= 2) {
        warn("DESTROY sv %p, state %p, ptr %p", SvRV(sv), lmc_state, lmc_state->ptr);
        if (lmc_state->trace_level >= 9)
            sv_dump(sv);
    }
    if (lmc_state->ptr)

libmemcached.xs  view on Meta::CPAN

void
get_multi(Memcached__libmemcached ptr, ...)
    PREINIT:
        HV *hv = newHV();
        SV *dest_ref = sv_2mortal(newRV_noinc((SV*)hv));
        char **keys;
        size_t *key_length;
        unsigned int number_of_keys = --items;
        memcached_return ret;
        lmc_cb_context_st *lmc_cb_context;
    PPCODE:
        /* XXX does not support keys being [ $master_key, $key ] */
        lmc_cb_context = LMC_STATE_FROM_PTR(ptr)->cb_context;

        if (number_of_keys > lmc_cb_context->key_alloc_count)
            _prep_keys_buffer(lmc_cb_context, number_of_keys);
        keys       = lmc_cb_context->key_strings;
        key_length = lmc_cb_context->key_lengths;
        while (--items >= 0) {
            keys[items] = SvPV(ST(items+1), key_length[items]);
        }

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

	 ( (??{ $size }) )?	# Possible sizeof set-from
	 \) \s* ; \s* $
	]x);
    $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
  }

  my $END = "!End!\n\n";		# "impossible" keyword (multiple newline)

  # Match an XS keyword
  $BLOCK_re= '\s*(' . join('|', qw(
				   REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT
				   CLEANUP ALIAS ATTRS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
				   SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL OVERLOAD FALLBACK
				  )) . "|$END)\\s*:";

  
  our ($C_group_rex, $C_arg);
  # Group in C (no support for comments or literals)
  $C_group_rex = qr/ [({\[]
		       (?: (?> [^()\[\]{}]+ ) | (??{ $C_group_rex }) )*
		       [)}\]] /x ;

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

    $report_args =~ s/^,\s+//;
    my @func_args = @args;
    shift @func_args if defined($class);

    for (@func_args) {
      s/^/&/ if $in_out{$_};
    }
    $func_args = join(", ", @func_args);
    @args_match{@args} = @args_num;

    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
    $CODE = grep(/^\s*CODE\s*:/, @line);
    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
    #   to set explicit return values.
    $EXPLICIT_RETURN = ($CODE &&
			("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);

    $xsreturn = 1 if $EXPLICIT_RETURN;

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

#    if ($cond)
#       Perl_croak(aTHX_ "Usage: %s(%s)", "$pname", "$report_args");
EOF
    
     # cv doesn't seem to be used, in most cases unless we go in 
     # the if of this else
     print Q(<<"EOF");
#    PERL_UNUSED_VAR(cv); /* -W */
EOF

    #gcc -Wall: if an xsub has PPCODE is used
    #it is possible none of ST, XSRETURN or XSprePUSH macros are used
    #hence `ax' (setup by dXSARGS) is unused
    #XXX: could breakup the dXSARGS; into dSP;dMARK;dITEMS
    #but such a move could break third-party extensions
    print Q(<<"EOF") if $PPCODE;
#    PERL_UNUSED_VAR(ax); /* -Wall */
EOF

    print Q(<<"EOF") if $PPCODE;
#    SP -= items;
EOF

    # Now do a block of some sort.

    $condnum = 0;
    $cond = '';			# last CASE: condidional
    push(@line, "$END:");
    push(@line_no, $line_no[-1]);
    $_ = '';

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

	  $processing_arg_with_types = 1;
	  INPUT_handler() ;
	}
	print delete $deferred{post_input};
	
        process_keyword("INIT|ALIAS|ATTRS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS|OVERLOAD") ;
	
	print delete $deferred{pre_call};
	print delete $deferred{auto_length_init};

	if (check_keyword("PPCODE")) {
	  print_section();
	  death ("PPCODE must be last thing") if @line;
	  print "\tLEAVE;\n" if $ScopeThisXSUB;
	  print "\tPUTBACK;\n\treturn;\n";
	} elsif (check_keyword("CODE")) {
	  print_section() ;
	} elsif (defined($class) and $func_name eq "DESTROY") {
	  print "\n\t";
	  print "delete THIS;\n";
	} else {
	  print "\n\t";
	  if ($ret_type ne "void") {

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

      print "\tEXTEND(SP,$c);\n" if $c;
      $xsreturn += $c;
      generate_output($var_types{$_}, $num++, $_, 0, 1) for @outlist;
      
      # do cleanup
      process_keyword("CLEANUP|ALIAS|ATTRS|PROTOTYPE|OVERLOAD") ;
      
      print Q(<<"EOF") if $ScopeThisXSUB;
#   ]]
EOF
      print Q(<<"EOF") if $ScopeThisXSUB and not $PPCODE;
#   LEAVE;
EOF
      
      # print function trailer
      print Q(<<"EOF");
#    ]]
EOF
      print Q(<<"EOF") if $except;
#    BEGHANDLERS
#    CATCHALL

t/lib/ExtUtils/ParseXS.pm  view on Meta::CPAN

      death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
      warn "internal error: deferred '$_' not consumed\n" for keys %deferred;
    }
    
    print Q(<<"EOF") if $except;
#    if (errbuf[0])
#	Perl_croak(aTHX_ errbuf);
EOF
    
    if ($xsreturn) {
      print Q(<<"EOF") unless $PPCODE;
#    XSRETURN($xsreturn);
EOF
    } else {
      print Q(<<"EOF") unless $PPCODE;
#    XSRETURN_EMPTY;
EOF
    }

    print Q(<<"EOF");
#]]
#
EOF

    my $newXS = "newXS" ;