components/perl/sun_solaris/src/Sun/Solaris/Exacct/File/File.xs

   1 /*
   2  * Copyright (c) 2002, Oracle and/or its affiliates. All rights reserved.
   3  *
   4  * File.xs contains XS code for exacct file manipulation.
   5  */
   6
   7 #include <pwd.h>
   8 #include "../exacct_common.xh"
   9
  10 /* Pull in the file generated by extract_defines. */
  11 #include "FileDefs.xi"
  12
  13 /*
  14  * The XS code exported to perl is below here.  Note that the XS preprocessor
  15  * has its own commenting syntax, so all comments from this point on are in
  16  * that form.
  17  */
  18
  19 MODULE = Sun::Solaris::Exacct::File PACKAGE = Sun::Solaris::Exacct::File
  20 PROTOTYPES: ENABLE
  21
  22  #
  23  # Define the stash pointers if required and create and populate @_Constants.
  24  #
  25 BOOT:
  26         {
  27         init_stashes();
  28         define_constants(PKGBASE "::File", constants);
  29         }
  30
  31  #
  32  # Open an exacct file and return an object with which to manipulate it.
  33  # The parameters are the filename, the open mode and a list of optional
  34  # (key => value) parameters where the key may be  one of creator, aflags or
  35  # mode.  For a full explanation of the various combinations, see the manpage
  36  # for ea_open_file(3EXACCT).
  37  #
  38 ea_file_t *
  39 new(class, name, oflags, ...)
  40         char    *class;
  41         char    *name;
  42         int     oflags;
  43 PREINIT:
  44         int     i;
  45         /* Assume usernames are <= 32 chars (pwck(1M) assumes <= 8) */
  46         char    user[33];
  47         char    *creator = NULL;
  48         int     aflags   = -1;
  49         mode_t  mode     = 0666;
  50 CODE:
  51         /*
  52          * Account for the mandatory parameters,
  53          * and the rest must be an even number.
  54          */
  55         i = items - 3;
  56         if ((i % 2) != 0) {
  57                 croak("Usage: Sun::Solaris::Exacct::File::new"
  58                     "(class, name, oflags, ...)");
  59         }
  60
  61         /* Process any optional parameters. */
  62         for (i = 3; i < items; i += 2) {
  63                 if (strEQ(SvPV_nolen(ST(i)), "creator")) {
  64                         creator = SvPV_nolen(ST(i + 1));
  65                 } else if (strEQ(SvPV_nolen(ST(i)), "aflags")) {
  66                         aflags = SvIV(ST(i + 1));
  67                 } else if (strEQ(SvPV_nolen(ST(i)), "mode")) {
  68                         mode = SvIV(ST(i + 1));
  69                 } else {
  70                         croak("invalid named argument %s", SvPV_nolen(ST(i)));
  71                 }
  72         }
  73
  74         /* Check and default the creator parameter. */
  75         if (oflags & O_CREAT && creator == NULL) {
  76                 uid_t           uid;
  77                 struct passwd   *pwent;
  78
  79                 uid = getuid();
  80                 if ((pwent = getpwuid(uid)) == NULL) {
  81                         snprintf(user, sizeof (user), "%d", uid);
  82                 } else {
  83                         strlcpy(user, pwent->pw_name, sizeof (user));
  84                 }
  85                 creator = user;
  86         }
  87
  88         /* Check and default the aflags parameter. */
  89         if (aflags == -1) {
  90                 if (oflags == O_RDONLY) {
  91                         aflags = EO_HEAD;
  92                 } else {
  93                         aflags = EO_TAIL;
  94                 }
  95         }
  96         RETVAL = ea_alloc(sizeof (ea_file_t));
  97         PERL_ASSERT(RETVAL != NULL);
  98         if (ea_open(RETVAL, name, creator, aflags, oflags, mode) == -1) {
  99                 ea_free(RETVAL, sizeof (ea_file_t));
 100                 RETVAL = NULL;
 101         }
 102 OUTPUT:
 103         RETVAL
 104
 105 void
 106 DESTROY(self)
 107         ea_file_t       *self;
 108 CODE:
 109         ea_close(self);
 110         ea_free(self, sizeof(ea_file_t));
 111
 112  #
 113  # Return the creator of the file.
 114  #
 115 SV*
 116 creator(self)
 117         ea_file_t       *self;
 118 PREINIT:
 119         const char      *creator;
 120 CODE:
 121         if ((creator = ea_get_creator(self)) == NULL) {
 122                 RETVAL = &PL_sv_undef;
 123         } else {
 124                 RETVAL = newSVpv(creator, 0);
 125         }
 126 OUTPUT:
 127         RETVAL
 128
 129  #
 130  # Return the hostname the file was created on.
 131  #
 132 SV*
 133 hostname(self)
 134         ea_file_t       *self;
 135 PREINIT:
 136         const char      *hostname;
 137 CODE:
 138         if ((hostname = ea_get_hostname(self)) == NULL) {
 139                 RETVAL = &PL_sv_undef;
 140         } else {
 141                 RETVAL = newSVpv(hostname, 0);
 142         }
 143 OUTPUT:
 144         RETVAL
 145
 146  #
 147  # Get the next/previous record from the file and return its type.
 148  # These two operations are so similar that the XSUB ALIAS functionality is
 149  # used to merge them into one function.
 150  #
 151 void
 152 next(self)
 153         ea_file_t       *self;
 154 ALIAS:
 155         previous = 1
 156 PREINIT:
 157         ea_object_type_t                type;
 158         const char                      *type_str;
 159         ea_object_t                     object;
 160         SV                              *sv;
 161         static const char *const        type_map[] =
 162             { "EO_NONE", "EO_GROUP", "EO_ITEM" };
 163 PPCODE:
 164         /* Call the appropriate next/last function. */
 165         if (ix == 0) {
 166                 type = ea_next_object(self, &object);
 167         } else {
 168                 type = ea_previous_object(self, &object);
 169         }
 170
 171         /* Work out the call context. */
 172         switch (GIMME_V) {
 173         case G_SCALAR:
 174                 /* In a scalar context, just return the type. */
 175                 EXTEND(SP, 1);
 176                 if (type == EO_ERROR) {
 177                         PUSHs(&PL_sv_undef);
 178                 } else {
 179                         sv = newSVuv(type);
 180                         sv_setpv(sv, type_map[type]);
 181                         SvIOK_on(sv);
 182                         PUSHs(sv_2mortal(sv));
 183                 }
 184                 break;
 185         case G_ARRAY:
 186                 /* In a list contect, return the type and catalog. */
 187                 EXTEND(SP, 2);
 188                 if (type == EO_ERROR) {
 189                         PUSHs(&PL_sv_undef);
 190                         PUSHs(&PL_sv_undef);
 191                 } else {
 192                         sv = newSVuv(type);
 193                         sv_setpv(sv, type_map[type]);
 194                         SvIOK_on(sv);
 195                         PUSHs(sv_2mortal(sv));
 196                         PUSHs(sv_2mortal(new_catalog(object.eo_catalog)));
 197                 }
 198                 break;
 199         case G_VOID:
 200         default:
 201                 /* In a void context, return nothing. */
 202                 break;
 203         }
 204
 205  #
 206  # Get the next object from the file and return as an ::Object.
 207  #
 208 SV*
 209 get(self)
 210         ea_file_t       *self;
 211 PREINIT:
 212         ea_object_t     *obj;
 213 CODE:
 214         if ((obj = ea_get_object_tree(self, 1)) != NULL) {
 215                 RETVAL = new_xs_ea_object(obj);
 216         } else {
 217                 RETVAL = &PL_sv_undef;
 218         }
 219 OUTPUT:
 220         RETVAL
 221
 222  #
 223  # Write the passed list of ::Objects to the file.
 224  # Returns true on success and false on failure.
 225  #
 226 SV*
 227 write(self, ...)
 228         ea_file_t       *self;
 229 PREINIT:
 230         int             i;
 231         SV              *sv;
 232         HV              *stash;
 233         ea_object_t     *obj;
 234 CODE:
 235         for (i = 1; i < items; i++) {
 236                 /* Check the value is either an ::Item or a ::Group. */
 237                 sv = SvRV(ST(i));
 238                 stash = sv ? SvSTASH(sv) : NULL;
 239                 if (stash != Sun_Solaris_Exacct_Object_Item_stash &&
 240                     stash != Sun_Solaris_Exacct_Object_Group_stash) {
 241                         XSRETURN_NO;
 242                 }
 243
 244                 /* Deflate and write the object. */
 245                 obj = deflate_xs_ea_object(ST(i));
 246                 PERL_ASSERT(obj != NULL);
 247                 if (ea_write_object(self, obj) == -1) {
 248                         XSRETURN_NO;
 249                 }
 250         }
 251         RETVAL = &PL_sv_yes;
 252 OUTPUT:
 253         RETVAL