File: native.xs

package info (click to toggle)
libconvert-binary-c-perl 0.74-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 9,100 kB
  • ctags: 21,416
  • sloc: ansic: 63,666; perl: 18,582; yacc: 2,143; makefile: 44
file content (61 lines) | stat: -rw-r--r-- 1,636 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2009/03/15 04:10:43 +0100 $
# $Revision: 8 $
# $Source: /xsubs/native.xs $
#
################################################################################
#
# Copyright (c) 2002-2009 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################


################################################################################
#
#   FUNCTION: native
#
#   WRITTEN BY: Marcus Holland-Moritz             ON: Aug 2004
#   CHANGED BY:                                   ON:
#
################################################################################
#
# DESCRIPTION: Get property of the native platform.
#
################################################################################

SV *
native(...)
  PREINIT:
    CBC_METHOD(native);
    int method_call;

  CODE:
    method_call = items > 0 && sv_isobject(ST(0));

    if (items > (method_call ? 2 : 1))
      Perl_croak(aTHX_ "Usage: Convert::Binary::C::native(property)");

    CHECK_VOID_CONTEXT;

    if (items == (method_call ? 1 : 0))
    {
      RETVAL = get_native_property(aTHX_ NULL);
    }
    else
    {
      const char *property = (const char *)SvPV_nolen(ST(items-1));

      RETVAL = get_native_property(aTHX_ property);

      if (RETVAL == NULL)
        Perl_croak(aTHX_ "Invalid property '%s'", property);
    }

  OUTPUT:
    RETVAL