src/pmc/env.pmc

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/pmc/env.pmc - System Environment
   8
   9 =head1 DESCRIPTION
  10
  11 C<Env> is a singleton class which provides access to the system environment.
  12
  13 =head2 Methods
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22
  23 /* array of environment variables,
  24    speced in POSIX.1, but not in ISO-C
  25    MS C compilers know about environ, as it is declared in stdlib.h.
  26    OS X doesn't allow access to "environ" from within shared libraries.
  27 */
  28 #ifndef WIN32
  29 #  ifdef __APPLE_CC__
  30 #    include <crt_externs.h>
  31 #    define environ (*_NSGetEnviron())
  32 #  else /* !__APPLE_CC__ */
  33 extern char **environ;
  34 #  endif /* __APPLE_CC__ */
  35 #endif /* !WIN32 */
  36
  37 static PMC *Env_PMC;
  38 pmclass Env singleton provides hash {
  39
  40 /*
  41
  42 =item C<void *get_pointer()>
  43
  44 =item C<void set_pointer(void *ptr)>
  45
  46 These two functions are part of the singleton creation interface. For more
  47 information see F<src/pmc.c>.
  48
  49 =cut
  50
  51 */
  52     void class_init() {
  53         Env_PMC = NULL;
  54     }
  55
  56     VTABLE void *get_pointer() {
  57         return Env_PMC;
  58     }
  59
  60     VTABLE void set_pointer(void *ptr) {
  61         Env_PMC = (PMC *)ptr;
  62     }
  63
  64 /*
  65
  66 =item C<PMC *get_iter()>
  67
  68 Returns a new iterator for the environment.
  69 This method is questionable, as environ is not in ISO-C.
  70
  71 =cut
  72
  73 */
  74
  75     VTABLE PMC *get_iter() {
  76         STRING *name         = CONST_STRING(interp, "set_key");
  77         PMC    *iter         = pmc_new_init(interp, enum_class_Iterator, SELF);
  78         PMC    *key          = pmc_new(interp, enum_class_Key);
  79
  80         Parrot_PCCINVOKE(interp, iter, name, "P->", key);
  81         PObj_get_FLAGS(key) |= KEY_integer_FLAG;
  82         PMC_int_val(key)     = 0;
  83
  84         if (!environ[0])
  85             PMC_int_val(key) = -1;
  86
  87         return iter;
  88     }
  89
  90 /*
  91
  92 =item C<INTVAL elements()>
  93
  94 Returns the number of elements in the environment.
  95 This method is questionable, as environ is not in ISO-C.
  96
  97 =cut
  98
  99 */
 100
 101     VTABLE INTVAL elements() {
 102         INTVAL rv = 0;
 103
 104         while (environ[rv] != NULL)
 105             rv++;
 106
 107         return rv;
 108     }
 109
 110 /*
 111
 112 =item C<INTVAL get_integer()>
 113
 114 Returns the size of the hash.
 115
 116 =cut
 117
 118 */
 119
 120     VTABLE INTVAL get_integer() {
 121         return SELF.elements();
 122     }
 123
 124 /*
 125
 126 =item C<FLOATVAL get_number()>
 127
 128 Returns the size of the hash.
 129
 130 =cut
 131
 132 */
 133     VTABLE FLOATVAL get_number() {
 134         return SELF.elements();
 135     }
 136
 137 /*
 138
 139 =item C<STRING *get_string_keyed(PMC *key)>
 140
 141 Returns the Parrot string value for the environment variable C<*key>.
 142
 143 =cut
 144
 145 */
 146
 147     VTABLE STRING *get_string_keyed(PMC *key) {
 148         if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
 149             if (PMC_int_val(key) < 0 || PMC_int_val(key) >= SELF.elements()) {
 150                 return CONST_STRING(interp, "");
 151             }
 152             else {
 153                 const char * const envp = environ[PMC_int_val(key)];
 154                 const char * const p    = strchr(envp, '=');
 155                 return string_from_cstring(interp, envp, (INTVAL)(p - envp));
 156             }
 157         }
 158         else {
 159             char * const keyname = string_to_cstring(interp,
 160                 VTABLE_get_string(interp, key));
 161             char *val            = NULL;
 162
 163             if (keyname) {
 164                 int free_it = 0;
 165                 val         = Parrot_getenv(keyname, &free_it);
 166                 string_cstring_free(keyname);
 167
 168                 if (val) {
 169                     STRING *retval = string_from_cstring(interp, val, 0);
 170
 171                     if (free_it)
 172                         mem_sys_free(val);
 173
 174                     return retval;
 175
 176                 }
 177             }
 178
 179             return CONST_STRING(interp, "");
 180         }
 181     }
 182
 183 /*
 184
 185 =item C<STRING *get_pmc_keyed(PMC *key)>
 186
 187 Returns a String PMC for the environment variable C<*key>.
 188
 189 =cut
 190
 191 */
 192
 193     VTABLE PMC *get_pmc_keyed(PMC *key) {
 194         char * const keyname = string_to_cstring(INTERP,
 195             VTABLE_get_string(INTERP, key));
 196
 197         char   *val     = NULL;
 198         STRING *retval  = NULL;
 199         PMC    *return_pmc;
 200
 201         if (keyname) {
 202             int free_it = 0;
 203             val         = Parrot_getenv(keyname, &free_it);
 204             string_cstring_free(keyname);
 205
 206             if (val) {
 207                 retval = string_from_cstring(INTERP, val, 0);
 208                 if (free_it)
 209                     mem_sys_free(val);
 210             }
 211         }
 212
 213         if (!retval)
 214             retval = CONST_STRING(INTERP, "");
 215
 216         return_pmc = pmc_new(INTERP, enum_class_String);
 217
 218         VTABLE_set_string_native(INTERP, return_pmc, retval);
 219         return return_pmc;
 220     }
 221
 222 /*
 223
 224 =item C<void set_string_keyed(PMC *key, STRING *value)>
 225
 226 Sets the environment variable C<*key> to C<*value>.
 227
 228 =cut
 229
 230 */
 231
 232     VTABLE void set_string_keyed(PMC *key, STRING *value) {
 233         char * const keyname = string_to_cstring(INTERP,
 234             VTABLE_get_string(INTERP, key));
 235         char * const env_val = string_to_cstring(INTERP, value);
 236
 237         if (keyname && env_val)
 238             Parrot_setenv(keyname, env_val);
 239
 240         if (keyname)
 241             string_cstring_free(keyname);
 242
 243         if (env_val)
 244             string_cstring_free(env_val);
 245     }
 246
 247 /*
 248
 249 =item C<void set_pmc_keyed(PMC *key, PMC *value)>
 250
 251 Sets the environment variable C<*key> to C<*value>.
 252
 253 =cut
 254
 255 */
 256
 257     VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
 258         char * const keyname = string_to_cstring(INTERP,
 259             VTABLE_get_string(INTERP, key));
 260
 261         const STRING * const str_value = VTABLE_get_string(INTERP, value);
 262         char         * const env_val   = string_to_cstring(INTERP, str_value);
 263
 264         if (keyname && env_val)
 265             Parrot_setenv(keyname, env_val);
 266
 267         if (keyname)
 268             string_cstring_free(keyname);
 269
 270         if (env_val)
 271             string_cstring_free(env_val);
 272     }
 273
 274 /*
 275
 276 =item C<INTVAL exists_keyed(PMC *key)>
 277
 278 Returns whether the environment variable for C<*key> exists.
 279
 280 =cut
 281
 282 */
 283
 284     VTABLE INTVAL exists_keyed(PMC *key) {
 285         char * const keyname = string_to_cstring(INTERP,
 286             VTABLE_get_string(INTERP, key));
 287
 288         if (keyname) {
 289             int free_it;
 290             char * const val = Parrot_getenv(keyname, &free_it);
 291             string_cstring_free(keyname);
 292
 293             if (val) {
 294                 if (free_it)
 295                     mem_sys_free(val);
 296                 return 1;
 297             }
 298         }
 299
 300         return 0;
 301     }
 302
 303 /*
 304
 305 =item C<void delete_keyed(PMC *key)>
 306
 307 Deletes the the environment variable for C<*key>.
 308
 309 =cut
 310
 311 */
 312
 313     VTABLE void delete_keyed(PMC *key) {
 314         char * const keyname = string_to_cstring(INTERP,
 315             VTABLE_get_string(INTERP, key));
 316
 317         if (keyname) {
 318             int          free_it;
 319             char * const val = Parrot_getenv(keyname, &free_it);
 320
 321             if (val) {
 322                 if (free_it)
 323                     mem_sys_free(val);
 324
 325                 Parrot_unsetenv(keyname);
 326             }
 327
 328             string_cstring_free(keyname);
 329         }
 330     }
 331 }
 332
 333 /*
 334
 335 =back
 336
 337 =head1 SEE ALS0
 338
 339 PDD -
 340 L<http://www.parrotcode.org/docs/pdd/pdd17_pdd.html#Hash_types>
 341
 342 Environment in Perl 6 - L<http://dev.perl.org/perl6/rfc/318.html>
 343
 344 Module for Perl 5 - L<http://search.cpan.org/~stas/Env-C-0.06/>
 345
 346 =cut
 347
 348 */
 349
 350 /*
 351  * Local variables:
 352  *   c-file-style: "parrot"
 353  * End:
 354  * vim: expandtab shiftwidth=4:
 355  */