Thu, 07 Aug 2008 01:41:44 +0000
Some cleanup and a couple leak fixes.
| 6678 | 1 | #define PERL_constant_NOTFOUND 1 |
| 2 | #define PERL_constant_NOTDEF 2 | |
| 3 | #define PERL_constant_ISIV 3 | |
| 4 | #define PERL_constant_ISNO 4 | |
| 5 | #define PERL_constant_ISNV 5 | |
| 6 | #define PERL_constant_ISPV 6 | |
| 7 | #define PERL_constant_ISPVN 7 | |
| 8 | #define PERL_constant_ISSV 8 | |
| 9 | #define PERL_constant_ISUNDEF 9 | |
| 10 | #define PERL_constant_ISUV 10 | |
| 11 | #define PERL_constant_ISYES 11 | |
| 12 | ||
| 13 | #ifndef NVTYPE | |
| 14 | typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ | |
| 15 | #endif | |
| 16 | #ifndef aTHX_ | |
| 17 | #define aTHX_ /* 5.6 or later define this for threading support. */ | |
| 18 | #endif | |
| 19 | #ifndef pTHX_ | |
| 20 | #define pTHX_ /* 5.6 or later define this for threading support. */ | |
| 21 | #endif | |
| 22 | ||
| 23 | static int | |
| 24 | constant (pTHX_ const char *name, STRLEN len, IV *iv_return) { | |
| 25 | /* Initially switch on the length of the name. */ | |
| 26 | /* When generated this function returned values for the list of names given | |
| 27 | in this section of perl code. Rather than manually editing these functions | |
| 28 | to add or remove constants, which would result in this comment and section | |
| 29 | of code becoming inaccurate, we recommend that you edit this section of | |
| 30 | code, and use it to regenerate a new set of constant functions which you | |
| 31 | then use to replace the originals. | |
| 32 | ||
| 33 | Regenerate these constant functions by feeding this entire source file to | |
| 34 | perl -x | |
| 35 | ||
|
22143
778676c8ac77
Don't assume perl is at /usr/bin/perl, use /usr/bin/env instead. This is not
Richard Laager <rlaager@pidgin.im>
parents:
15894
diff
changeset
|
36 | #!/usr/bin/env perl -w |
| 6678 | 37 | use ExtUtils::Constant qw (constant_types C_constant XS_constant); |
| 38 | ||
| 39 | my $types = {map {($_, 1)} qw(IV)}; | |
| 40 | my @names = (qw(), | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
41 | {name=>"PURPLE_DEBUG_ALL", type=>"IV", macro=>"1"}, |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
42 | {name=>"PURPLE_DEBUG_ERROR", type=>"IV", macro=>"1"}, |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
43 | {name=>"PURPLE_DEBUG_FATAL", type=>"IV", macro=>"1"}, |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
44 | {name=>"PURPLE_DEBUG_INFO", type=>"IV", macro=>"1"}, |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
45 | {name=>"PURPLE_DEBUG_MISC", type=>"IV", macro=>"1"}, |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
46 | {name=>"PURPLE_DEBUG_WARNING", type=>"IV", macro=>"1"}); |
| 6678 | 47 | |
| 48 | print constant_types(); # macro defs | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
49 | foreach (C_constant ("Purple::DebugLevel", 'constant', 'IV', $types, undef, 3, @names) ) { |
| 6678 | 50 | print $_, "\n"; # C constant subs |
| 51 | } | |
| 52 | print "#### XS Section:\n"; | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
53 | print XS_constant ("Purple::DebugLevel", $types); |
| 6678 | 54 | __END__ |
| 55 | */ | |
| 56 | ||
| 57 | switch (len) { | |
| 58 | case 14: | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
59 | if (memEQ(name, "PURPLE_DEBUG_ALL", 14)) { |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
60 | *iv_return = PURPLE_DEBUG_ALL; |
| 6678 | 61 | return PERL_constant_ISIV; |
| 62 | } | |
| 63 | break; | |
| 64 | case 15: | |
| 65 | /* Names all of length 15. */ | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
66 | /* PURPLE_DEBUG_INFO PURPLE_DEBUG_MISC */ |
| 6678 | 67 | /* Offset 11 gives the best switch position. */ |
| 68 | switch (name[11]) { | |
| 69 | case 'I': | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
70 | if (memEQ(name, "PURPLE_DEBUG_INFO", 15)) { |
| 6678 | 71 | /* ^ */ |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
72 | *iv_return = PURPLE_DEBUG_INFO; |
| 6678 | 73 | return PERL_constant_ISIV; |
| 74 | } | |
| 75 | break; | |
| 76 | case 'M': | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
77 | if (memEQ(name, "PURPLE_DEBUG_MISC", 15)) { |
| 6678 | 78 | /* ^ */ |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
79 | *iv_return = PURPLE_DEBUG_MISC; |
| 6678 | 80 | return PERL_constant_ISIV; |
| 81 | } | |
| 82 | break; | |
| 83 | } | |
| 84 | break; | |
| 85 | case 16: | |
| 86 | /* Names all of length 16. */ | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
87 | /* PURPLE_DEBUG_ERROR PURPLE_DEBUG_FATAL */ |
| 6678 | 88 | /* Offset 11 gives the best switch position. */ |
| 89 | switch (name[11]) { | |
| 90 | case 'E': | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
91 | if (memEQ(name, "PURPLE_DEBUG_ERROR", 16)) { |
| 6678 | 92 | /* ^ */ |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
93 | *iv_return = PURPLE_DEBUG_ERROR; |
| 6678 | 94 | return PERL_constant_ISIV; |
| 95 | } | |
| 96 | break; | |
| 97 | case 'F': | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
98 | if (memEQ(name, "PURPLE_DEBUG_FATAL", 16)) { |
| 6678 | 99 | /* ^ */ |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
100 | *iv_return = PURPLE_DEBUG_FATAL; |
| 6678 | 101 | return PERL_constant_ISIV; |
| 102 | } | |
| 103 | break; | |
| 104 | } | |
| 105 | break; | |
| 106 | case 18: | |
|
15894
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
107 | if (memEQ(name, "PURPLE_DEBUG_WARNING", 18)) { |
|
765ec644ac47
Perl fixes for s/gaim/purple/. This hasn't really been tested yet.
Daniel Atallah <datallah@pidgin.im>
parents:
15435
diff
changeset
|
108 | *iv_return = PURPLE_DEBUG_WARNING; |
| 6678 | 109 | return PERL_constant_ISIV; |
| 110 | } | |
| 111 | break; | |
| 112 | } | |
| 113 | return PERL_constant_NOTFOUND; | |
| 114 | } | |
| 115 |