From fef1801ec21825d9175bc13f5e1ef69b9bacbf13 Mon Sep 17 00:00:00 2001 From: Don Lipari <lipari1@llnl.gov> Date: Wed, 21 Apr 2010 00:30:50 +0000 Subject: [PATCH] Moved common stuff of libslurm/perl/msg.h to perlapi/common directory Made incremental enhancements to perlapi/libslurmdb --- .../perlapi/{libslurmdb/perl => common}/msg.h | 30 +- contribs/perlapi/libslurm/Makefile.am | 2 +- contribs/perlapi/libslurm/Makefile.in | 2 +- contribs/perlapi/libslurm/perl/Makefile.PL.in | 2 +- contribs/perlapi/libslurm/perl/Slurm.xs | 2 +- contribs/perlapi/libslurm/perl/alloc.c | 2 +- contribs/perlapi/libslurm/perl/conf.c | 2 +- contribs/perlapi/libslurm/perl/job.c | 2 +- contribs/perlapi/libslurm/perl/launch.c | 2 +- contribs/perlapi/libslurm/perl/msg.h | 282 --------- contribs/perlapi/libslurm/perl/node.c | 2 +- contribs/perlapi/libslurm/perl/partition.c | 2 +- contribs/perlapi/libslurm/perl/slurm-perl.h | 43 ++ contribs/perlapi/libslurm/perl/trigger.c | 2 +- contribs/perlapi/libslurmdb/Makefile.am | 2 +- contribs/perlapi/libslurmdb/Makefile.in | 2 +- .../perlapi/libslurmdb/perl/Makefile.PL.in | 2 +- contribs/perlapi/libslurmdb/perl/Slurmdb.pm | 51 +- contribs/perlapi/libslurmdb/perl/Slurmdb.xs | 68 +- contribs/perlapi/libslurmdb/perl/cluster.c | 597 +++++++++++++++++- .../perlapi/libslurmdb/perl/slurmdb-perl.h | 22 + contribs/perlapi/libslurmdb/perl/t/00-use.t | 12 + .../libslurmdb/perl/t/01-clusters_get.t | 36 ++ .../t/02-report_cluster_account_by_user.t | 55 ++ contribs/perlapi/libslurmdb/perl/t/Slurmdb.t | 32 - 25 files changed, 834 insertions(+), 422 deletions(-) rename contribs/perlapi/{libslurmdb/perl => common}/msg.h (95%) delete mode 100644 contribs/perlapi/libslurm/perl/msg.h create mode 100644 contribs/perlapi/libslurm/perl/slurm-perl.h create mode 100644 contribs/perlapi/libslurmdb/perl/slurmdb-perl.h create mode 100755 contribs/perlapi/libslurmdb/perl/t/00-use.t create mode 100755 contribs/perlapi/libslurmdb/perl/t/01-clusters_get.t create mode 100755 contribs/perlapi/libslurmdb/perl/t/02-report_cluster_account_by_user.t delete mode 100755 contribs/perlapi/libslurmdb/perl/t/Slurmdb.t diff --git a/contribs/perlapi/libslurmdb/perl/msg.h b/contribs/perlapi/common/msg.h similarity index 95% rename from contribs/perlapi/libslurmdb/perl/msg.h rename to contribs/perlapi/common/msg.h index 7fb0e19e762..a17362990c0 100644 --- a/contribs/perlapi/libslurmdb/perl/msg.h +++ b/contribs/perlapi/common/msg.h @@ -76,12 +76,13 @@ inline static int hv_store_charp(HV* hv, const char *key, charp val) { SV* sv = NULL; - if(val) + if (val) { sv = newSVpv(val, 0); - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; + if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { + SvREFCNT_dec(sv); + return -1; + } } return 0; } @@ -177,6 +178,21 @@ inline static int hv_store_uint8_t(HV* hv, const char *key, uint8_t val) } return 0; } + +/* + * store a uid_t into HV + */ +inline static int hv_store_uid_t(HV* hv, const char *key, uid_t val) +{ + SV* sv = newSVuv(val); + + if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { + SvREFCNT_dec(sv); + return -1; + } + return 0; +} + /* * store a signed int into HV */ @@ -243,7 +259,6 @@ inline static int hv_store_ptr(HV* hv, const char *key, void* ptr) SvREFCNT_dec(sv); return -1; } - return 0; } @@ -276,9 +291,4 @@ inline static int hv_store_ptr(HV* hv, const char *key, void* ptr) } while (0) -extern int hv_to_cluster_cond(HV* hv, slurmdb_cluster_cond_t* cluster_cond); -extern int cluster_accounting_rec_to_hv(slurmdb_cluster_accounting_rec_t *ar, HV* hv); -extern int cluster_rec_to_hv(slurmdb_cluster_rec_t *rec, HV* hv); - - #endif /* _MSG_H */ diff --git a/contribs/perlapi/libslurm/Makefile.am b/contribs/perlapi/libslurm/Makefile.am index 4683cea8cd2..98e81857ee1 100644 --- a/contribs/perlapi/libslurm/Makefile.am +++ b/contribs/perlapi/libslurm/Makefile.am @@ -9,7 +9,7 @@ perl_sources = \ $(perl_dir)/Slurm.pm \ $(perl_dir)/Slurm.xs \ $(perl_dir)/typemap \ - $(perl_dir)/msg.h \ + $(perl_dir)/slurm-perl.h \ $(perl_dir)/alloc.c \ $(perl_dir)/conf.c \ $(perl_dir)/job.c \ diff --git a/contribs/perlapi/libslurm/Makefile.in b/contribs/perlapi/libslurm/Makefile.in index 7ce6096e7cb..195d333db9b 100644 --- a/contribs/perlapi/libslurm/Makefile.in +++ b/contribs/perlapi/libslurm/Makefile.in @@ -275,7 +275,7 @@ perl_sources = \ $(perl_dir)/Slurm.pm \ $(perl_dir)/Slurm.xs \ $(perl_dir)/typemap \ - $(perl_dir)/msg.h \ + $(perl_dir)/slurm-perl.h \ $(perl_dir)/alloc.c \ $(perl_dir)/conf.c \ $(perl_dir)/job.c \ diff --git a/contribs/perlapi/libslurm/perl/Makefile.PL.in b/contribs/perlapi/libslurm/perl/Makefile.PL.in index f1e4b234e3a..20717ba4b17 100644 --- a/contribs/perlapi/libslurm/perl/Makefile.PL.in +++ b/contribs/perlapi/libslurm/perl/Makefile.PL.in @@ -90,7 +90,7 @@ WriteMakefile( AUTHOR => 'Hongjia Cao <hjcao@nudt.edu.cn>') : ()), LIBS => ["-L@top_builddir@/src/api/.libs -L@prefix@/lib -lslurm"], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' - INC => "-I. -I@top_srcdir@ -I@top_builddir@", # e.g., '-I. -I/usr/include/other' + INC => "-I. -I@top_srcdir@ -I@top_srcdir@/contribs/perlapi/common -I@top_builddir@", # Un-comment this if you add C files to link with later: OBJECT => '$(O_FILES)', # link all the C files too CCFLAGS => '-g', diff --git a/contribs/perlapi/libslurm/perl/Slurm.xs b/contribs/perlapi/libslurm/perl/Slurm.xs index 85e57ea2c0c..33d3a5993f6 100644 --- a/contribs/perlapi/libslurm/perl/Slurm.xs +++ b/contribs/perlapi/libslurm/perl/Slurm.xs @@ -8,7 +8,7 @@ #include <signal.h> #include <string.h> #include <unistd.h> -#include "msg.h" +#include "slurm-perl.h" #include "const-c.inc" diff --git a/contribs/perlapi/libslurm/perl/alloc.c b/contribs/perlapi/libslurm/perl/alloc.c index fbd9dbdfdff..8608afe2a86 100644 --- a/contribs/perlapi/libslurm/perl/alloc.c +++ b/contribs/perlapi/libslurm/perl/alloc.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" static void _free_environment(char** environ); diff --git a/contribs/perlapi/libslurm/perl/conf.c b/contribs/perlapi/libslurm/perl/conf.c index 625127c2ec6..2b1e6cb9a97 100644 --- a/contribs/perlapi/libslurm/perl/conf.c +++ b/contribs/perlapi/libslurm/perl/conf.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" /* diff --git a/contribs/perlapi/libslurm/perl/job.c b/contribs/perlapi/libslurm/perl/job.c index 755b16899ef..662eff8e7a5 100644 --- a/contribs/perlapi/libslurm/perl/job.c +++ b/contribs/perlapi/libslurm/perl/job.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" /* * convert job_info_t to perl HV diff --git a/contribs/perlapi/libslurm/perl/launch.c b/contribs/perlapi/libslurm/perl/launch.c index c69548dfbf3..3fe8b6f07ea 100644 --- a/contribs/perlapi/libslurm/perl/launch.c +++ b/contribs/perlapi/libslurm/perl/launch.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" /* * convert perl HV to slurm_step_ctx_params_t diff --git a/contribs/perlapi/libslurm/perl/msg.h b/contribs/perlapi/libslurm/perl/msg.h deleted file mode 100644 index 10b21cd5e46..00000000000 --- a/contribs/perlapi/libslurm/perl/msg.h +++ /dev/null @@ -1,282 +0,0 @@ -/* - * msg2hv.h - prototypes of msg-hv converting functions - */ - -#ifndef _MSG_H -#define _MSG_H - -#include <perl.h> - -typedef char* charp; - -/* - * store an uint16_t into AV - */ -inline static int av_store_uint16_t(AV* av, int index, uint16_t val) -{ - SV* sv = NULL; - /* Perl has a hard time figuring out the an unsigned int is - equal to INFINITE or NO_VAL since they are treated as - signed ints so we will handle this here. */ - if(val == (uint16_t)INFINITE) - sv = newSViv(INFINITE); - else if(val == (uint16_t)NO_VAL) - sv = newSViv(NO_VAL); - else - sv = newSViv(val); - - if (av_store(av, (I32)index, sv) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store an uint32_t into AV - */ -inline static int av_store_uint32_t(AV* av, int index, uint32_t val) -{ - SV* sv = NULL; - /* Perl has a hard time figuring out the an unsigned int is - equal to INFINITE or NO_VAL since they are treated as - signed ints so we will handle this here. */ - if(val == (uint32_t)INFINITE) - sv = newSViv(INFINITE); - else if(val == (uint32_t)NO_VAL) - sv = newSViv(NO_VAL); - else - sv = newSViv(val); - - if (av_store(av, (I32)index, sv) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store an int into AV - */ -inline static int av_store_int(AV* av, int index, int val) -{ - SV* sv = newSViv(val); - - if (av_store(av, (I32)index, sv) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store a string into HV - */ -inline static int hv_store_charp(HV* hv, const char *key, charp val) -{ - SV* sv = NULL; - - if(val) - sv = newSVpv(val, 0); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store an unsigned 32b int into HV - */ -inline static int hv_store_uint32_t(HV* hv, const char *key, uint32_t val) -{ - SV* sv = NULL; - /* Perl has a hard time figuring out the an unsigned int is - equal to INFINITE or NO_VAL since they are treated as - signed ints so we will handle this here. */ - if(val == (uint32_t)INFINITE) - sv = newSViv(INFINITE); - else if(val == (uint32_t)NO_VAL) - sv = newSViv(NO_VAL); - else - sv = newSVuv(val); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store an unsigned 16b int into HV - */ -inline static int hv_store_uint16_t(HV* hv, const char *key, uint16_t val) -{ - SV* sv = NULL; - /* Perl has a hard time figuring out the an unsigned int is - equal to INFINITE or NO_VAL since they are treated as - signed ints so we will handle this here. */ - if(val == (uint16_t)INFINITE) - sv = newSViv(INFINITE); - else if(val == (uint16_t)NO_VAL) - sv = newSViv(NO_VAL); - else - sv = newSVuv(val); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store an unsigned 8b int into HV - */ -inline static int hv_store_uint8_t(HV* hv, const char *key, uint8_t val) -{ - SV* sv = NULL; - /* Perl has a hard time figuring out the an unsigned int is - equal to INFINITE or NO_VAL since they are treated as - signed ints so we will handle this here. */ - if(val == (uint8_t)INFINITE) - sv = newSViv(INFINITE); - else if(val == (uint8_t)NO_VAL) - sv = newSViv(NO_VAL); - else - sv = newSVuv(val); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} -/* - * store a signed int into HV - */ -inline static int hv_store_int(HV* hv, const char *key, int val) -{ - SV* sv = newSViv(val); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store a bool into HV - */ -inline static int hv_store_bool(HV* hv, const char *key, bool val) -{ - if (!key || hv_store(hv, key, (I32)strlen(key), (val ? &PL_sv_yes : &PL_sv_no), 0) == NULL) { - return -1; - } - return 0; -} - -/* - * store a time_t into HV - */ -inline static int hv_store_time_t(HV* hv, const char *key, time_t val) -{ - SV* sv = newSVuv(val); - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - return 0; -} - -/* - * store a SV into HV - */ -inline static int hv_store_sv(HV* hv, const char *key, SV* sv) -{ - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - return -1; - } - return 0; -} - -/* - * store a PTR into HV - */ -inline static int hv_store_ptr(HV* hv, const char *key, void* ptr) -{ - SV* sv = NULL; - - if(ptr) { - sv = NEWSV(0, 0); - sv_setref_pv(sv, key, ptr); - } - - if (!key || hv_store(hv, key, (I32)strlen(key), sv, 0) == NULL) { - SvREFCNT_dec(sv); - return -1; - } - - return 0; -} - -#define SV2uint32_t(sv) SvUV(sv) -#define SV2uint16_t(sv) SvUV(sv) -#define SV2uint8_t(sv) SvUV(sv) -#define SV2time_t(sv) SvUV(sv) -#define SV2charp(sv) SvPV_nolen(sv) -#define SV2bool(sv) SvTRUE(sv) -#define SV2ptr(sv) SvIV(SvRV(sv)) - - -#define FETCH_FIELD(hv, ptr, field, type, required) \ - do { \ - SV** svp; \ - if ( (svp = hv_fetch (hv, #field, strlen(#field), FALSE)) ) { \ - ptr->field = (type) (SV2##type (*svp)); \ - } else if (required) { \ - Perl_warn (aTHX_ "Required field \"" #field "\" missing in HV"); \ - return -1; \ - } \ - } while (0) - -#define STORE_FIELD(hv, ptr, field, type) \ - do { \ - if (hv_store_##type(hv, #field, ptr->field)) { \ - Perl_warn (aTHX_ "Failed to store field \"" #field "\""); \ - return -1; \ - } \ - } while (0) - - -extern int hv_to_job_desc_msg(HV* hv, job_desc_msg_t* job_desc_msg); -extern void free_job_desc_msg_memory(job_desc_msg_t *msg); -extern int resource_allocation_response_msg_to_hv(resource_allocation_response_msg_t* resp_msg, HV* hv); -extern int job_alloc_info_response_msg_to_hv(job_alloc_info_response_msg_t *resp_msg, HV* hv); -extern int submit_response_msg_to_hv(submit_response_msg_t *resp_msg, HV* hv); - -extern int job_info_msg_to_hv(job_info_msg_t* job_info_msg, HV* hv); -extern int job_step_info_response_msg_to_hv(job_step_info_response_msg_t* job_step_info_msg, HV* hv); -extern int slurm_step_layout_to_hv(slurm_step_layout_t* step_layout, HV* hv); - -extern int node_info_msg_to_hv(node_info_msg_t* node_info_msg, HV* hv); -extern int hv_to_update_node_msg(HV* hv, update_node_msg_t *update_msg); - -extern int partition_info_msg_to_hv(partition_info_msg_t* part_info_msg, HV* hv); -extern int hv_to_update_part_msg(HV* hv, update_part_msg_t* part_msg); - -extern int slurm_ctl_conf_to_hv(slurm_ctl_conf_t* conf, HV* hv); - -extern int trigger_info_to_hv(trigger_info_t *info, HV* hv); -extern int trigger_info_msg_to_hv(trigger_info_msg_t *msg, HV* hv); -extern int hv_to_trigger_info(HV* hv, trigger_info_t* info); - -extern int hv_to_slurm_step_ctx_params(HV* hv, slurm_step_ctx_params_t* params); -extern int hv_to_slurm_step_launch_params(HV* hv, slurm_step_launch_params_t *params); -extern void free_slurm_step_launch_params_memory(slurm_step_launch_params_t *params); - -#endif /* _MSG_H */ diff --git a/contribs/perlapi/libslurm/perl/node.c b/contribs/perlapi/libslurm/perl/node.c index 3154ae579b4..57824cb429a 100644 --- a/contribs/perlapi/libslurm/perl/node.c +++ b/contribs/perlapi/libslurm/perl/node.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" #ifdef HAVE_BG /* These are just helper functions from slurm proper that don't get diff --git a/contribs/perlapi/libslurm/perl/partition.c b/contribs/perlapi/libslurm/perl/partition.c index cecab7194c4..2d8a9493d94 100644 --- a/contribs/perlapi/libslurm/perl/partition.c +++ b/contribs/perlapi/libslurm/perl/partition.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" /* * convert partition_info_t to perl HV diff --git a/contribs/perlapi/libslurm/perl/slurm-perl.h b/contribs/perlapi/libslurm/perl/slurm-perl.h new file mode 100644 index 00000000000..60c0ac6dfc0 --- /dev/null +++ b/contribs/perlapi/libslurm/perl/slurm-perl.h @@ -0,0 +1,43 @@ +/* + * slurm-perl.h - prototypes of msg-hv converting functions + */ + +#ifndef _SLURMDB_PERL_H +#define _SLURMDB_PERL_H + +#include <msg.h> + + +extern int hv_to_job_desc_msg(HV* hv, job_desc_msg_t* job_desc_msg); +extern void free_job_desc_msg_memory(job_desc_msg_t *msg); +extern int resource_allocation_response_msg_to_hv( + resource_allocation_response_msg_t* resp_msg, HV* hv); +extern int job_alloc_info_response_msg_to_hv(job_alloc_info_response_msg_t + *resp_msg, HV* hv); +extern int submit_response_msg_to_hv(submit_response_msg_t *resp_msg, HV* hv); + +extern int job_info_msg_to_hv(job_info_msg_t* job_info_msg, HV* hv); +extern int job_step_info_response_msg_to_hv(job_step_info_response_msg_t* + job_step_info_msg, HV* hv); +extern int slurm_step_layout_to_hv(slurm_step_layout_t* step_layout, HV* hv); + +extern int node_info_msg_to_hv(node_info_msg_t* node_info_msg, HV* hv); +extern int hv_to_update_node_msg(HV* hv, update_node_msg_t *update_msg); + +extern int partition_info_msg_to_hv(partition_info_msg_t* part_info_msg, + HV* hv); +extern int hv_to_update_part_msg(HV* hv, update_part_msg_t* part_msg); + +extern int slurm_ctl_conf_to_hv(slurm_ctl_conf_t* conf, HV* hv); + +extern int trigger_info_to_hv(trigger_info_t *info, HV* hv); +extern int trigger_info_msg_to_hv(trigger_info_msg_t *msg, HV* hv); +extern int hv_to_trigger_info(HV* hv, trigger_info_t* info); + +extern int hv_to_slurm_step_ctx_params(HV* hv, slurm_step_ctx_params_t* params); +extern int hv_to_slurm_step_launch_params(HV* hv, slurm_step_launch_params_t + *params); +extern void free_slurm_step_launch_params_memory(slurm_step_launch_params_t + *params); + +#endif /* _SLURMDB_PERL_H */ diff --git a/contribs/perlapi/libslurm/perl/trigger.c b/contribs/perlapi/libslurm/perl/trigger.c index 56f65162a48..d71d0cd5018 100644 --- a/contribs/perlapi/libslurm/perl/trigger.c +++ b/contribs/perlapi/libslurm/perl/trigger.c @@ -7,7 +7,7 @@ #include <XSUB.h> #include <slurm/slurm.h> -#include "msg.h" +#include "slurm-perl.h" /* * convert trigger_info_t to perl HV diff --git a/contribs/perlapi/libslurmdb/Makefile.am b/contribs/perlapi/libslurmdb/Makefile.am index cdea8586341..2755f7e3b46 100644 --- a/contribs/perlapi/libslurmdb/Makefile.am +++ b/contribs/perlapi/libslurmdb/Makefile.am @@ -8,7 +8,7 @@ perl_sources = \ $(perl_dir)/ppport.h \ $(perl_dir)/Slurmdb.pm \ $(perl_dir)/Slurmdb.xs \ - $(perl_dir)/msg.h \ + $(perl_dir)/slurmdb-perl.h \ $(perl_dir)/cluster.c $(perl_dir)/Makefile: $(perl_dir)/Makefile.PL diff --git a/contribs/perlapi/libslurmdb/Makefile.in b/contribs/perlapi/libslurmdb/Makefile.in index a31934155ae..9b2855d753c 100644 --- a/contribs/perlapi/libslurmdb/Makefile.in +++ b/contribs/perlapi/libslurmdb/Makefile.in @@ -274,7 +274,7 @@ perl_sources = \ $(perl_dir)/ppport.h \ $(perl_dir)/Slurmdb.pm \ $(perl_dir)/Slurmdb.xs \ - $(perl_dir)/msg.h \ + $(perl_dir)/slurmdb-perl.h \ $(perl_dir)/cluster.c AM_CPPFLAGS = \ diff --git a/contribs/perlapi/libslurmdb/perl/Makefile.PL.in b/contribs/perlapi/libslurmdb/perl/Makefile.PL.in index 1a7c6636442..72b288cc274 100644 --- a/contribs/perlapi/libslurmdb/perl/Makefile.PL.in +++ b/contribs/perlapi/libslurmdb/perl/Makefile.PL.in @@ -89,7 +89,7 @@ WriteMakefile( AUTHOR => 'Don Lipari <lipari@llnl.gov>') : ()), LIBS => ["-L@top_builddir@/src/db_api/.libs -L@prefix@/lib -lslurmdb"], # e.g., '-lm' DEFINE => '', # e.g., '-DHAVE_SOMETHING' - INC => "-I. -I@top_srcdir@ -I@top_builddir@", # e.g., '-I. -I/usr/include/other' + INC => "-I. -I@top_srcdir@ -I@top_srcdir@/contribs/perlapi/common -I@top_builddir@", # Un-comment this if you add C files to link with later: OBJECT => '$(O_FILES)', # link all the C files too CCFLAGS => '-g', diff --git a/contribs/perlapi/libslurmdb/perl/Slurmdb.pm b/contribs/perlapi/libslurmdb/perl/Slurmdb.pm index 43ee31b8e2b..7adc001c9f2 100644 --- a/contribs/perlapi/libslurmdb/perl/Slurmdb.pm +++ b/contribs/perlapi/libslurmdb/perl/Slurmdb.pm @@ -70,56 +70,7 @@ our %EXPORT_TAGS = ( 'all' => [ qw( our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); -our @EXPORT = qw( - SLURMDB_ADD_ASSOC - SLURMDB_ADD_COORD - SLURMDB_ADD_QOS - SLURMDB_ADD_USER - SLURMDB_ADD_WCKEY - SLURMDB_ADMIN_NONE - SLURMDB_ADMIN_NOTSET - SLURMDB_ADMIN_OPERATOR - SLURMDB_ADMIN_SUPER_USER - SLURMDB_CLASSIFIED_FLAG - SLURMDB_CLASS_BASE - SLURMDB_CLASS_CAPABILITY - SLURMDB_CLASS_CAPACITY - SLURMDB_CLASS_CAPAPACITY - SLURMDB_CLASS_NONE - SLURMDB_EVENT_ALL - SLURMDB_EVENT_CLUSTER - SLURMDB_EVENT_NODE - SLURMDB_MODIFY_ASSOC - SLURMDB_MODIFY_QOS - SLURMDB_MODIFY_USER - SLURMDB_MODIFY_WCKEY - SLURMDB_PROBLEM_ACCT_NO_ASSOC - SLURMDB_PROBLEM_ACCT_NO_USERS - SLURMDB_PROBLEM_NOT_SET - SLURMDB_PROBLEM_USER_NO_ASSOC - SLURMDB_PROBLEM_USER_NO_UID - SLURMDB_PURGE_ARCHIVE - SLURMDB_PURGE_BASE - SLURMDB_PURGE_DAYS - SLURMDB_PURGE_FLAGS - SLURMDB_PURGE_HOURS - SLURMDB_PURGE_MONTHS - SLURMDB_REMOVE_ASSOC - SLURMDB_REMOVE_COORD - SLURMDB_REMOVE_QOS - SLURMDB_REMOVE_USER - SLURMDB_REMOVE_WCKEY - SLURMDB_REPORT_SORT_NAME - SLURMDB_REPORT_SORT_TIME - SLURMDB_REPORT_TIME_HOURS - SLURMDB_REPORT_TIME_HOURS_PER - SLURMDB_REPORT_TIME_MINS - SLURMDB_REPORT_TIME_MINS_PER - SLURMDB_REPORT_TIME_PERCENT - SLURMDB_REPORT_TIME_SECS - SLURMDB_REPORT_TIME_SECS_PER - SLURMDB_UPDATE_NOTSET -); +our @EXPORT = qw(); our $VERSION = '0.01'; diff --git a/contribs/perlapi/libslurmdb/perl/Slurmdb.xs b/contribs/perlapi/libslurmdb/perl/Slurmdb.xs index d06f5b44619..46c48be13af 100644 --- a/contribs/perlapi/libslurmdb/perl/Slurmdb.xs +++ b/contribs/perlapi/libslurmdb/perl/Slurmdb.xs @@ -6,10 +6,14 @@ #include <slurm/slurm.h> #include <slurm/slurmdb.h> -#include "msg.h" +#include "slurmdb-perl.h" #include "const-c.inc" +extern void *slurm_xmalloc(size_t, const char *, int, const char *); +extern void slurmdb_destroy_association_cond(void *object); +extern void slurmdb_destroy_cluster_cond(void *object); + MODULE = Slurmdb PACKAGE = Slurmdb PREFIX=slurmdb_ @@ -21,38 +25,70 @@ slurmdb_connection_get() int slurmdb_connection_close(db_conn) - void *db_conn + void* db_conn SV* slurmdb_clusters_get(db_conn, conditions) - void *db_conn - HV* conditions + void* db_conn + HV* conditions INIT: AV * results; HV * rh; - List list = slurm_list_create(NULL); + List list = NULL; ListIterator itr; - slurmdb_cluster_cond_t cluster_cond; + slurmdb_cluster_cond_t *cluster_cond = (slurmdb_cluster_cond_t*) + slurm_xmalloc(sizeof(slurmdb_cluster_cond_t), __FILE__, + __LINE__, "slurmdb_clusters_get"); slurmdb_cluster_rec_t *rec = NULL; - if (hv_to_cluster_cond(conditions, &cluster_cond) < 0) { + if (hv_to_cluster_cond(conditions, cluster_cond) < 0) { XSRETURN_UNDEF; } results = (AV *)sv_2mortal((SV *)newAV()); CODE: - list = slurmdb_clusters_get(db_conn, &cluster_cond); - itr = slurm_list_iterator_create(list); + list = slurmdb_clusters_get(db_conn, cluster_cond); + if (list) { + itr = slurm_list_iterator_create(list); - while ((rec = slurm_list_next(itr))) { - rh = (HV *)sv_2mortal((SV *)newHV()); - if (cluster_rec_to_hv(rec, rh) < 0) { - XSRETURN_UNDEF; + while ((rec = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (cluster_rec_to_hv(rec, rh) < 0) { + XSRETURN_UNDEF; + } + av_push(results, newRV((SV *)rh)); } - av_push(results, newRV((SV *)rh)); + slurm_list_destroy(list); } RETVAL = newRV((SV *)results); - slurm_list_destroy(cluster_cond.cluster_list); - slurm_list_destroy(list); + slurmdb_destroy_cluster_cond(cluster_cond); OUTPUT: RETVAL +SV* +slurmdb_report_cluster_account_by_user(db_conn, assoc_condition) + void* db_conn + HV* assoc_condition + INIT: + AV * results; + List list = NULL; + slurmdb_association_cond_t *assoc_cond = (slurmdb_association_cond_t*) + slurm_xmalloc(sizeof(slurmdb_association_cond_t), __FILE__, + __LINE__, "slurmdb_report_cluster_account_by_user"); + + if (hv_to_assoc_cond(assoc_condition, assoc_cond) < 0) { + XSRETURN_UNDEF; + } + results = (AV *)sv_2mortal((SV *)newAV()); + CODE: + list = slurmdb_report_cluster_account_by_user(db_conn, assoc_cond); + if (list) { + if (report_cluster_rec_list_to_av(list, results) < 0) { + XSRETURN_UNDEF; + } + + slurm_list_destroy(list); + } + RETVAL = newRV((SV *)results); + slurmdb_destroy_association_cond(assoc_cond); + OUTPUT: + RETVAL diff --git a/contribs/perlapi/libslurmdb/perl/cluster.c b/contribs/perlapi/libslurmdb/perl/cluster.c index 0e4752fb9b6..9a9175d2c06 100644 --- a/contribs/perlapi/libslurmdb/perl/cluster.c +++ b/contribs/perlapi/libslurmdb/perl/cluster.c @@ -7,9 +7,10 @@ #include <XSUB.h> #include <slurm/slurmdb.h> -#include "msg.h" +#include "slurmdb-perl.h" -char *slurm_xstrdup(const char *str); +extern char *slurm_xstrdup(const char *str); +extern int slurmdb_report_set_start_end_time(time_t *start, time_t *end); int hv_to_cluster_cond(HV* hv, slurmdb_cluster_cond_t* cluster_cond) @@ -32,15 +33,13 @@ hv_to_cluster_cond(HV* hv, slurmdb_cluster_cond_t* cluster_cond) if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { cluster_av = (AV*)SvRV(*svp); elements = av_len(cluster_av) + 1; - if (elements > 0) { - for(i = 0; i < elements; i ++) { - if((svp = av_fetch(cluster_av, i, FALSE))) { - cluster = slurm_xstrdup((char*)SvPV_nolen(*svp)); - slurm_list_append(cluster_cond->cluster_list, cluster); - } else { - Perl_warn(aTHX_ "error fetching cluster from cluster_list"); - return -1; - } + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(cluster_av, i, FALSE))) { + cluster = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(cluster_cond->cluster_list, cluster); + } else { + Perl_warn(aTHX_ "error fetching cluster from cluster_list"); + return -1; } } } else { @@ -57,6 +56,443 @@ hv_to_cluster_cond(HV* hv, slurmdb_cluster_cond_t* cluster_cond) return 0; } +int +hv_to_assoc_cond(HV* hv, slurmdb_association_cond_t* assoc_cond) +{ + AV* element_av; + SV** svp; + char* str = NULL; + int i, elements = 0; + time_t start_time = 0; + time_t end_time = 0; + + if ( (svp = hv_fetch (hv, "usage_start", strlen("usage_start"), FALSE)) ) { + start_time = (time_t) (SV2time_t(*svp)); + } + if ( (svp = hv_fetch (hv, "usage_end", strlen("usage_end"), FALSE)) ) { + end_time = (time_t) (SV2time_t(*svp)); + } + slurmdb_report_set_start_end_time(&start_time, &end_time); + assoc_cond->usage_start = start_time; + assoc_cond->usage_end = end_time; + + assoc_cond->with_usage = 1; + assoc_cond->with_deleted = 0; + assoc_cond->with_raw_qos = 0; + assoc_cond->with_sub_accts = 0; + assoc_cond->without_parent_info = 0; + assoc_cond->without_parent_limits = 0; + + FETCH_FIELD(hv, assoc_cond, with_usage, uint16_t, FALSE); + FETCH_FIELD(hv, assoc_cond, with_deleted, uint16_t, FALSE); + FETCH_FIELD(hv, assoc_cond, with_raw_qos, uint16_t, FALSE); + FETCH_FIELD(hv, assoc_cond, with_sub_accts, uint16_t, FALSE); + FETCH_FIELD(hv, assoc_cond, without_parent_info, uint16_t, FALSE); + FETCH_FIELD(hv, assoc_cond, without_parent_limits, uint16_t, FALSE); + + if((svp = hv_fetch(hv, "acct_list", strlen("acct_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->acct_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->acct_list, str); + } else { + Perl_warn(aTHX_ "error fetching acct from acct_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "acct_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "cluster_list", strlen("cluster_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->cluster_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->cluster_list, str); + } else { + Perl_warn(aTHX_ "error fetching cluster from cluster_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "cluster_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "fairshare_list", strlen("fairshare_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->fairshare_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->fairshare_list, str); + } else { + Perl_warn(aTHX_ "error fetching fairshare from fairshare_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "fairshare_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_cpu_mins_list", strlen("grp_cpu_mins_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_cpu_mins_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_cpu_mins_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_cpu_mins from grp_cpu_mins_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_cpu_mins_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_cpus_list", strlen("grp_cpus_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_cpus_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_cpus_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_cpus from grp_cpus_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_cpus_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_jobs_list", strlen("grp_jobs_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_jobs_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_jobs_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_jobs from grp_jobs_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_jobs_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_nodes_list", strlen("grp_nodes_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_nodes_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_nodes_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_nodes from grp_nodes_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_nodes_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_submit_jobs_list", strlen("grp_submit_jobs_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_submit_jobs_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_submit_jobs_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_submit_jobs from grp_submit_jobs_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_submit_jobs_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "grp_wall_list", strlen("grp_wall_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->grp_wall_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->grp_wall_list, str); + } else { + Perl_warn(aTHX_ "error fetching grp_wall from grp_wall_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "grp_wall_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "id_list", strlen("id_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->id_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->id_list, str); + } else { + Perl_warn(aTHX_ "error fetching id from id_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "id_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_cpu_mins_pj_list", strlen("max_cpu_mins_pj_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_cpu_mins_pj_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_cpu_mins_pj_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_cpu_mins_pj from max_cpu_mins_pj_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_cpu_mins_pj_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_cpus_pj_list", strlen("max_cpus_pj_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_cpus_pj_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_cpus_pj_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_cpus_pj from max_cpus_pj_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_cpus_pj_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_jobs_list", strlen("max_jobs_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_jobs_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_jobs_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_jobs from max_jobs_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_jobs_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_nodes_pj_list", strlen("max_nodes_pj_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_nodes_pj_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_nodes_pj_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_nodes_pj from max_nodes_pj_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_nodes_pj_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_submit_jobs_list", strlen("max_submit_jobs_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_submit_jobs_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_submit_jobs_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_submit_jobs from max_submit_jobs_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_submit_jobs_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "max_wall_pj_list", strlen("max_wall_pj_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->max_wall_pj_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->max_wall_pj_list, str); + } else { + Perl_warn(aTHX_ "error fetching max_wall_pj from max_wall_pj_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "max_wall_pj_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "partition_list", strlen("partition_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->partition_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->partition_list, str); + } else { + Perl_warn(aTHX_ "error fetching partition from partition_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "partition_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "parent_acct_list", strlen("parent_acct_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->parent_acct_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->parent_acct_list, str); + } else { + Perl_warn(aTHX_ "error fetching parent_acct from parent_acct_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "parent_acct_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "qos_list", strlen("qos_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->qos_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->qos_list, str); + } else { + Perl_warn(aTHX_ "error fetching qos from qos_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "qos_list of association_cond is not an array reference"); + return -1; + } + } + + if((svp = hv_fetch(hv, "user_list", strlen("user_list"), FALSE))) { + if(SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVAV) { + assoc_cond->user_list = slurm_list_create(NULL); + element_av = (AV*)SvRV(*svp); + elements = av_len(element_av) + 1; + for(i = 0; i < elements; i ++) { + if((svp = av_fetch(element_av, i, FALSE))) { + str = slurm_xstrdup((char*)SvPV_nolen(*svp)); + slurm_list_append(assoc_cond->user_list, str); + } else { + Perl_warn(aTHX_ "error fetching user from user_list"); + return -1; + } + } + } else { + Perl_warn(aTHX_ "user_list of association_cond is not an array reference"); + return -1; + } + } + + return 0; +} + int cluster_accounting_rec_to_hv(slurmdb_cluster_accounting_rec_t *ar, HV* hv) { @@ -75,16 +511,22 @@ cluster_accounting_rec_to_hv(slurmdb_cluster_accounting_rec_t *ar, HV* hv) int cluster_rec_to_hv(slurmdb_cluster_rec_t *rec, HV* hv) { - AV * acc_av; + AV * acc_av = (AV *)sv_2mortal((SV *)newAV()); HV * rh; - ListIterator itr = slurm_list_iterator_create(rec->accounting_list); + ListIterator itr = NULL; slurmdb_cluster_accounting_rec_t* ar = NULL; - acc_av = (AV *)sv_2mortal((SV *)newAV()); - while ((ar = slurm_list_next(itr))) { - rh = (HV *)sv_2mortal((SV *)newHV()); - cluster_accounting_rec_to_hv(ar, rh); - av_push(acc_av, newRV_noinc((SV *)rh)); + if (rec->accounting_list) { + itr = slurm_list_iterator_create(rec->accounting_list); + while ((ar = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (cluster_accounting_rec_to_hv(ar, rh) < 0) { + Perl_warn(aTHX_ "Failed to convert a cluster_accounting_rec to a hv"); + return -1; + } else { + av_push(acc_av, newRV((SV *)rh)); + } + } } hv_store_sv(hv, "accounting_list", newRV((SV*)acc_av)); STORE_FIELD(hv, rec, classification, uint16_t); @@ -99,3 +541,122 @@ cluster_rec_to_hv(slurmdb_cluster_rec_t *rec, HV* hv) return 0; } +int +report_assoc_rec_to_hv(slurmdb_report_assoc_rec_t *ar, HV* hv) +{ + STORE_FIELD(hv, ar, acct, charp); + STORE_FIELD(hv, ar, cluster, charp); + STORE_FIELD(hv, ar, cpu_secs, uint64_t); + STORE_FIELD(hv, ar, parent_acct, charp); + STORE_FIELD(hv, ar, user, charp); + + return 0; +} + +int +report_user_rec_to_hv(slurmdb_report_user_rec_t *rec, HV* hv) +{ + AV * acc_av = (AV *)sv_2mortal((SV *)newAV()); + AV * char_av = (AV *)sv_2mortal((SV *)newAV()); + HV * rh; + char* acct; + slurmdb_report_assoc_rec_t *ar = NULL; + ListIterator itr = NULL; + + if (rec->acct_list) { + itr = slurm_list_iterator_create(rec->acct_list); + while ((acct = slurm_list_next(itr))) { + av_push(char_av, newRV(newSVpv(acct, strlen(acct)))); + } + } + hv_store_sv(hv, "acct_list", newRV((SV*)char_av)); + + if (rec->assoc_list) { + itr = slurm_list_iterator_create(rec->assoc_list); + while ((ar = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (report_assoc_rec_to_hv(ar, rh) < 0) { + Perl_warn(aTHX_ "Failed to convert a report_assoc_rec to a hv"); + return -1; + } else { + av_push(acc_av, newRV((SV *)rh)); + } + } + } + hv_store_sv(hv, "assoc_list", newRV((SV*)acc_av)); + + STORE_FIELD(hv, rec, acct, charp); + STORE_FIELD(hv, rec, cpu_secs, uint64_t); + STORE_FIELD(hv, rec, name, charp); + STORE_FIELD(hv, rec, uid, uid_t); + + return 0; +} + +int +report_cluster_rec_to_hv(slurmdb_report_cluster_rec_t* rec, HV* hv) +{ + AV * acc_av = (AV *)sv_2mortal((SV *)newAV()); + AV * usr_av = (AV *)sv_2mortal((SV *)newAV()); + HV * rh; + slurmdb_report_assoc_rec_t* ar = NULL; + slurmdb_report_user_rec_t* ur = NULL; + ListIterator itr = NULL; + + if (rec->assoc_list) { + itr = slurm_list_iterator_create(rec->assoc_list); + while ((ar = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (report_assoc_rec_to_hv(ar, rh) < 0) { + Perl_warn(aTHX_ "Failed to convert a report_assoc_rec to a hv"); + return -1; + } else { + av_push(acc_av, newRV((SV *)rh)); + } + } + } + hv_store_sv(hv, "assoc_list", newRV((SV*)acc_av)); + + STORE_FIELD(hv, rec, cpu_count, uint32_t); + STORE_FIELD(hv, rec, cpu_secs, uint64_t ); + STORE_FIELD(hv, rec, name, charp); + + if (rec->user_list) { + itr = slurm_list_iterator_create(rec->user_list); + while ((ur = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (report_user_rec_to_hv(ur, rh) < 0) { + Perl_warn(aTHX_ "Failed to convert a report_user_rec to a hv"); + return -1; + } else { + av_push(usr_av, newRV((SV *)rh)); + } + } + } + hv_store_sv(hv, "user_list", newRV((SV*)usr_av)); + + return 0; +} + +int +report_cluster_rec_list_to_av(List list, AV* av) +{ + HV * rh; + ListIterator itr = NULL; + slurmdb_report_cluster_rec_t* rec = NULL; + + if (list) { + itr = slurm_list_iterator_create(list); + while ((rec = slurm_list_next(itr))) { + rh = (HV *)sv_2mortal((SV *)newHV()); + if (report_cluster_rec_to_hv(rec, rh) < 0) { + Perl_warn(aTHX_ "Failed to convert a report_cluster_rec to a hv"); + return -1; + } else { + av_push(av, newRV((SV *)rh)); + } + } + } + + return 0; +} diff --git a/contribs/perlapi/libslurmdb/perl/slurmdb-perl.h b/contribs/perlapi/libslurmdb/perl/slurmdb-perl.h new file mode 100644 index 00000000000..69f5efe6cde --- /dev/null +++ b/contribs/perlapi/libslurmdb/perl/slurmdb-perl.h @@ -0,0 +1,22 @@ +/* + * slurmdb-perl.h - prototypes of msg-hv converting functions + */ + +#ifndef _SLURMDB_PERL_H +#define _SLURMDB_PERL_H + +#include <msg.h> + + +extern int hv_to_cluster_cond(HV* hv, slurmdb_cluster_cond_t* cluster_cond); +extern int hv_to_assoc_cond(HV* hv, slurmdb_association_cond_t* assoc_cond); +extern int cluster_accounting_rec_to_hv(slurmdb_cluster_accounting_rec_t *ar, + HV* hv); +extern int cluster_rec_to_hv(slurmdb_cluster_rec_t *rec, HV* hv); +extern int report_assoc_rec_to_hv(slurmdb_report_assoc_rec_t *ar, HV* hv); +extern int report_user_rec_to_hv(slurmdb_report_user_rec_t *rec, HV* hv); +extern int report_cluster_rec_to_hv(slurmdb_report_cluster_rec_t* rec, HV* hv); +extern int report_cluster_rec_list_to_av(List list, AV* av); + + +#endif /* _SLURMDB_PERL_H */ diff --git a/contribs/perlapi/libslurmdb/perl/t/00-use.t b/contribs/perlapi/libslurmdb/perl/t/00-use.t new file mode 100755 index 00000000000..df63d102f9f --- /dev/null +++ b/contribs/perlapi/libslurmdb/perl/t/00-use.t @@ -0,0 +1,12 @@ +#!/usr/bin/perl -T +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Slurmdb.t' +use strict; +use warnings; + +######################### + +use Test::More tests => 1; +BEGIN { use_ok('Slurmdb') }; + +######################### diff --git a/contribs/perlapi/libslurmdb/perl/t/01-clusters_get.t b/contribs/perlapi/libslurmdb/perl/t/01-clusters_get.t new file mode 100755 index 00000000000..6def6d258ca --- /dev/null +++ b/contribs/perlapi/libslurmdb/perl/t/01-clusters_get.t @@ -0,0 +1,36 @@ +#!/usr/bin/perl -T +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Slurmdb.t' +use strict; +use warnings; + +######################### + +use Test::More tests => 3; +BEGIN { use_ok('Slurmdb') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + +my $db_conn = Slurmdb::connection_get(); + +my %hv = (); + +my $clusters = Slurmdb::clusters_get($db_conn, \%hv); +ok( $clusters != 0, 'clusters_get' ); + +for (my $i = 0; $i < @$clusters; $i++) { + + print "classification $clusters->[$i]{'classification'}\n"; + print "control_host $clusters->[$i]{'control_host'}\n"; + print "control_port $clusters->[$i]{'control_port'}\n"; + print "cpu_count $clusters->[$i]{'cpu_count'}\n"; + print "name $clusters->[$i]{'name'}\n"; + print "nodes $clusters->[$i]{'nodes'}\n"; + print "rpc_version $clusters->[$i]{'rpc_version'}\n"; +} + +my $rc = Slurmdb::connection_close($db_conn); +ok( $rc == 0, 'connection_close' ); diff --git a/contribs/perlapi/libslurmdb/perl/t/02-report_cluster_account_by_user.t b/contribs/perlapi/libslurmdb/perl/t/02-report_cluster_account_by_user.t new file mode 100755 index 00000000000..2609bab8467 --- /dev/null +++ b/contribs/perlapi/libslurmdb/perl/t/02-report_cluster_account_by_user.t @@ -0,0 +1,55 @@ +#!/usr/bin/perl -T +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Slurmdb.t' +use strict; +use warnings; + +######################### + +use Test::More tests => 2; +BEGIN { use_ok('Slurmdb') }; + +######################### + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + +my $db_conn = Slurmdb::connection_get(); + +my %assoc_cond = (); + +my $accounts = Slurmdb::report_cluster_account_by_user($db_conn, \%assoc_cond); + +for (my $i = 0; $i < @$accounts; $i++) { + for (my $j = 0; $j < @{$accounts->[$i]{'assoc_list'}}; $j++) { + print "$j assoc_list acct $accounts->[$i]{'assoc_list'}[$j]{'acct'}\n" + if exists $accounts->[$i]{'assoc_list'}[$j]{'acct'}; + print "$j assoc_list cluster $accounts->[$i]{'assoc_list'}[$j]{'cluster'}\n" + if exists $accounts->[$i]{'assoc_list'}[$j]{'cluster'}; + print "$j assoc_list cpu_secs $accounts->[$i]{'assoc_list'}[$j]{'cpu_secs'}\n" + if exists $accounts->[$i]{'assoc_list'}[$j]{'cpu_secs'}; + print "$j assoc_list parent_acct $accounts->[$i]{'assoc_list'}[$j]{'parent_acct'}\n" + if exists $accounts->[$i]{'assoc_list'}[$j]{'parent_acct'}; + print "$j assoc_list user $accounts->[$i]{'assoc_list'}[$j]{'user'}\n" + if exists $accounts->[$i]{'assoc_list'}[$j]{'user'}; + } + + print "cpu_count $accounts->[$i]{'cpu_count'}\n" + if exists $accounts->[$i]{'cpu_count'}; + print "cpu_secs $accounts->[$i]{'cpu_secs'}\n" + if exists $accounts->[$i]{'cpu_secs'}; + print "name $accounts->[$i]{'name'}\n" + if exists $accounts->[$i]{'name'}; + + for (my $j = 0; $j < @{$accounts->[$i]{'user_list'}}; $j++) { + print "user_list acct $accounts->[$i]{'user_list'}->{'acct'}\n"; + #print "user_list acct_list $accounts->[$i]{'user_list'}->[0]{'acct_list'}\n"; + #print "user_list assoc_list $accounts->[$i]{'user_list'}->[0]{'assoc_list'}\n"; + print "user_list cpu_secs $accounts->[$i]{'user_list'}->[0]{'cpu_secs'}\n"; + print "user_list name $accounts->[$i]{'user_list'}->[0]{'name'}\n"; + print "user_list uid $accounts->[$i]{'user_list'}->[0]{'uid'}\n"; + } +} + +my $rc = Slurmdb::connection_close($db_conn); +ok( $rc == 0, 'connection_close' ); diff --git a/contribs/perlapi/libslurmdb/perl/t/Slurmdb.t b/contribs/perlapi/libslurmdb/perl/t/Slurmdb.t deleted file mode 100755 index dbc1868af37..00000000000 --- a/contribs/perlapi/libslurmdb/perl/t/Slurmdb.t +++ /dev/null @@ -1,32 +0,0 @@ -# Before `make install' is performed this script should be runnable with -# `make test'. After `make install' it should work as `perl Slurmdb.t' - -######################### - -# change 'tests => 4' to 'tests => last_test_to_print'; - -use Test::More tests => 1; -BEGIN { use_ok('Slurmdb') }; - -######################### - -# Insert your test code below, the Test::More module is use()ed here so read -# its man page ( perldoc Test::More ) for help writing this test script. - -my $db_conn = Slurmdb::connection_get(); - -my %hv = (); - -my $results = Slurmdb::clusters_get($db_conn, \%hv); - -my $rc = Slurmdb::connection_close($db_conn); - -print "return code: $rc\n"; - -print "classification $results->[0]{'classification'}\n"; -print "control_host $results->[0]{'control_host'}\n"; -print "control_port $results->[0]{'control_port'}\n"; -print "cpu_count $results->[0]{'cpu_count'}\n"; -print "name $results->[0]{'name'}\n"; -print "nodes $results->[0]{'nodes'}\n"; -print "rpc_version $results->[0]{'rpc_version'}\n"; -- GitLab