Dogcows Code - chaz/homebank/blob - src/ext-perl.xs

   1
   2 #include <EXTERN.h>
   3 #include <perl.h>
   4 #include <XSUB.h>
   5
   6 #include <string.h>
   7
   8 #undef _
   9 #include "homebank.h"
  10 #include "ext.h"
  11 #include "refcount.h"
  12
  13 extern struct HomeBank *GLOBALS;
  14 #include "dsp_mainwindow.h"
  15 #include "dsp_account.h"
  16 #include "ui-transaction.h"
  17
  18
  19 static gint ext_perl_init(int* argc, char** argv[], char** env[]);
  20 static void ext_perl_term(void);
  21 static gboolean ext_perl_check_file(const gchar* plugin_filepath);
  22 static GHashTable* ext_perl_read_plugin_metadata(const gchar* plugin_filepath);
  23 static gint ext_perl_load_plugin(const gchar* plugin_filepath);
  24 static void ext_perl_unload_plugin(const gchar* plugin_filepath);
  25 static void ext_perl_execute_action(const gchar* plugin_filepath);
  26 static void ext_perl_call_hook(const gchar* hook_id, GList* args);
  27
  28 static SV* val_to_sv(GValue* val);
  29 static GValue* sv_to_val(SV* sv);
  30
  31 static gboolean gperl_value_from_sv(GValue* value, SV* sv);
  32 static SV*      gperl_sv_from_value(const GValue* value, gboolean copy_boxed);
  33
  34
  35 static inline GValue* EXT_SV(GValue* v, SV* sv, GType type)
  36 {
  37         g_value_init(v, type);
  38         gperl_value_from_sv(v, sv);
  39         return v;
  40 }
  41
  42
  43 #define EXT_P2C_OBJECT(PKG, ARG, VAR, TYP)  \
  44 if (sv_derived_from(ARG, PKG)) {            \
  45     IV iv = SvIV((SV*)SvRV(ARG));           \
  46     VAR = INT2PTR(TYP, iv);                 \
  47 } else {                                    \
  48     croak(#VAR" is not of type "PKG);       \
  49 }
  50
  51 #define EXT_C2P_OBJECT(PKG, ARG, VAR)       \
  52 sv_setref_pv(ARG, PKG, (void*)VAR)
  53
  54
  55 static inline GPtrArray* SvGptrarray(const SV* sv)
  56 {
  57         if (SvROK(sv)) {
  58                 sv = MUTABLE_SV(SvRV(sv));
  59         }
  60         if (SvTYPE(sv) == SVt_PVAV) {
  61                 AV* av = (AV*)sv;
  62                 int i;
  63                 int top = av_len(av);
  64                 GPtrArray* array = g_ptr_array_new();
  65                 for (i = 0; i <= top; ++i) {
  66                         SV** item = av_fetch(av, i, 0);
  67                         if (!item) continue;
  68                         g_ptr_array_add(array, sv_to_val(*item));
  69                 }
  70                 return array;
  71                 // TODO- leaking
  72         } else {
  73                 croak("var is not an array");
  74         }
  75 }
  76
  77 static inline SV* newSVgptrarray(const GPtrArray* a)
  78 {
  79         if (a) {
  80                 AV* av = newAV();
  81                 int i;
  82                 for (i = 0; i < a->len; ++i) {
  83                         GValue* item = g_ptr_array_index(a, i);
  84                         av_push(av, val_to_sv(item));
  85                 }
  86                 return newRV((SV*)av);
  87         }
  88         return &PL_sv_undef;
  89 }
  90
  91
  92 static inline GHashTable* SvGhashtable(const SV* sv)
  93 {
  94         if (SvROK(sv)) {
  95                 sv = MUTABLE_SV(SvRV(sv));
  96         }
  97         if (SvTYPE(sv) == SVt_PVHV) {
  98                 HV* hv = (HV*)sv;
  99                 hv_iterinit(hv);
 100                 gchar* key;
 101                 I32 len;
 102                 SV* item;
 103                 GHashTable* hash = g_hash_table_new(g_str_hash, g_str_equal);
 104                 while ((item = hv_iternextsv(hv, &key, &len))) {
 105                         g_hash_table_insert(hash, key, sv_to_val(item));
 106                 }
 107                 return hash;
 108                 // TODO- leaking
 109         } else {
 110                 croak("var is not a hash");
 111         }
 112 }
 113
 114 static inline SV* newSVghashtable(GHashTable* h)
 115 {
 116         if (h) {
 117                 HV* hv = newHV();
 118                 GHashTableIter it;
 119                 g_hash_table_iter_init(&it, h);
 120                 gchar* key = NULL;
 121                 GValue* item = NULL;
 122                 while (g_hash_table_iter_next(&it, (gpointer*)&key, (gpointer*)&item)) {
 123                         hv_store(hv, key, -g_utf8_strlen(key, -1), val_to_sv(item), 0);
 124                 }
 125                 return newRV((SV*)hv);
 126         }
 127         return &PL_sv_undef;
 128 }
 129
 130
 131 static inline gboolean SvGboolean(SV* sv)
 132 {
 133         if (!sv) {
 134                 return FALSE;
 135         }
 136         if (SvROK(sv)) {
 137                 return !!SvIV(SvRV(sv));
 138         } else {
 139                 return SvTRUE(sv);
 140         }
 141 }
 142
 143 static inline SV* newSVgboolean(gboolean b)
 144 {
 145         return sv_setref_iv(newSV(0), "HomeBank::Boolean", !!b);
 146 }
 147
 148
 149 static inline gchar* SvGchar_ptr(SV* sv)
 150 {
 151         return SvPVutf8_nolen(sv);
 152 }
 153
 154 static inline SV* newSVgchar_ptr(const gchar* str)
 155 {
 156         if (!str) return &PL_sv_undef;
 157
 158         SV* sv = newSVpv(str, 0);
 159         SvUTF8_on(sv);
 160         return sv;
 161 }
 162
 163
 164 static inline GObject* SvGobject(const SV* sv)
 165 {
 166         GObject* (*func)(const SV*) = ext_symbol_lookup("gperl_get_object");
 167         if (func) {
 168                 return func(sv);
 169         }
 170         return NULL;
 171 }
 172
 173 static inline SV* newSVgobject(const GObject* o)
 174 {
 175     SV* (*func)(const GObject*, gboolean) = ext_symbol_lookup("gperl_new_object");
 176     if (func) {
 177         return func(o, FALSE);
 178     }
 179         return &PL_sv_undef;
 180 }
 181
 182
 183 static PerlInterpreter* context = NULL;
 184
 185
 186 static gint ext_perl_init(int* argc, char** argv[], char** env[])
 187 {
 188         int ret = 0;
 189
 190         PERL_SYS_INIT3(argc, argv, env);
 191         context = perl_alloc();
 192         perl_construct(context);
 193
 194         PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
 195         PL_origalen = 1;
 196         PL_perl_destruct_level = 1;
 197
 198         gchar* bootstrap = g_strdup_printf("-e"
 199                 "use lib '%s';"
 200                 "use HomeBank;"
 201                 "HomeBank->bootstrap;",
 202                 homebank_app_get_pkglib_dir());
 203         char *args[] = { "", bootstrap };
 204
 205         EXTERN_C void xs_init(pTHX);
 206         if (perl_parse(context, xs_init, 2, args, NULL) || perl_run(context)) {
 207                 ext_perl_term();
 208                 ret = -1;
 209         }
 210
 211         g_free(bootstrap);
 212         return ret;
 213 }
 214
 215 static void ext_perl_term(void)
 216 {
 217         if (context) {
 218                 perl_destruct(context);
 219                 perl_free(context);
 220                 context = NULL;
 221         }
 222         PERL_SYS_TERM();
 223 }
 224
 225 static gboolean ext_perl_check_file(const gchar* plugin_filepath)
 226 {
 227         if (g_str_has_suffix(plugin_filepath, ".pl")) {
 228                 return TRUE;
 229         }
 230         return FALSE;
 231 }
 232
 233 static GHashTable* ext_perl_read_plugin_metadata(const gchar* plugin_filepath)
 234 {
 235         GHashTable* table = NULL;
 236
 237         if (!context) return NULL;
 238         PERL_SET_CONTEXT(context);
 239
 240         dSP;
 241         ENTER;
 242         SAVETMPS;
 243         PUSHMARK(SP);
 244         mXPUSHs(newSVgchar_ptr(plugin_filepath));
 245         PUTBACK;
 246
 247         int ret = call_pv("HomeBank::read_metadata", G_SCALAR | G_EVAL);
 248
 249         SPAGAIN;
 250
 251         if (ret == 1) {
 252                 table = g_hash_table_new_full(g_str_hash, g_str_equal, g_free, g_free);
 253                 SV* sv = POPs;
 254                 if (SvROK(sv)) {
 255                         sv = MUTABLE_SV(SvRV(sv));
 256                 }
 257                 if (SvTYPE(sv) == SVt_PVHV) {
 258                         HV* hv = (HV*)sv;
 259                         hv_iterinit(hv);
 260                         gchar* key;
 261                         I32 len;
 262                         SV* item;
 263                         while ((item = hv_iternextsv(hv, &key, &len))) {
 264                                 if (SvPOK(item)) {
 265                                         gchar* val = SvPVutf8_nolen(item);
 266                                         g_hash_table_insert(table, g_strdup(key), g_strdup(val));
 267                                 }
 268                         }
 269                 }
 270         }
 271
 272         PUTBACK;
 273         FREETMPS;
 274         LEAVE;
 275
 276         return table;
 277 }
 278
 279 static gint ext_perl_load_plugin(const gchar* plugin_filepath)
 280 {
 281         if (!context) return -1;
 282         PERL_SET_CONTEXT(context);
 283
 284         dSP;
 285         ENTER;
 286         SAVETMPS;
 287         PUSHMARK(SP);
 288         mXPUSHs(newSVgchar_ptr(plugin_filepath));
 289         PUTBACK;
 290         call_pv("HomeBank::load_plugin", G_DISCARD | G_EVAL);
 291         SPAGAIN;
 292
 293         gint ret = 0;
 294         if (SvTRUE(ERRSV)) {
 295                 g_printerr("%s", SvPV_nolen(ERRSV));
 296                 ret = -1;
 297         }
 298
 299         PUTBACK;
 300         FREETMPS;
 301         LEAVE;
 302
 303         return ret;
 304 }
 305
 306 static void ext_perl_unload_plugin(const gchar* plugin_filepath)
 307 {
 308         if (!context) return;
 309         PERL_SET_CONTEXT(context);
 310
 311         dSP;
 312         ENTER;
 313         SAVETMPS;
 314         PUSHMARK(SP);
 315         mXPUSHs(newSVgchar_ptr(plugin_filepath));
 316         PUTBACK;
 317         call_pv("HomeBank::unload_plugin", G_DISCARD | G_EVAL);
 318         SPAGAIN;
 319
 320         if (SvTRUE(ERRSV)) {
 321                 g_printerr("%s", SvPV_nolen(ERRSV));
 322         }
 323
 324         PUTBACK;
 325         FREETMPS;
 326         LEAVE;
 327 }
 328
 329 static void ext_perl_execute_action(const gchar* plugin_filepath)
 330 {
 331         if (!context) return;
 332         PERL_SET_CONTEXT(context);
 333
 334         dSP;
 335         ENTER;
 336         SAVETMPS;
 337         PUSHMARK(SP);
 338         mXPUSHs(newSVgchar_ptr(plugin_filepath));
 339         PUTBACK;
 340         call_pv("HomeBank::execute_action", G_DISCARD | G_EVAL);
 341         SPAGAIN;
 342
 343         if (SvTRUE(ERRSV)) {
 344                 g_printerr("%s", SvPV_nolen(ERRSV));
 345         }
 346
 347         PUTBACK;
 348         FREETMPS;
 349         LEAVE;
 350 }
 351
 352 static void ext_perl_call_hook(const gchar* hook_id, GList* args)
 353 {
 354         if (!context) return;
 355         PERL_SET_CONTEXT(context);
 356
 357         dSP;
 358         ENTER;
 359         SAVETMPS;
 360         PUSHMARK(SP);
 361         mXPUSHs(newSVgchar_ptr(hook_id));
 362
 363         GList *list = g_list_first(args);
 364         while (list) {
 365                 GValue* val = list->data;
 366                 XPUSHs(sv_2mortal(val_to_sv(val)));
 367                 list = g_list_next(list);
 368         }
 369
 370         PUTBACK;
 371         call_pv("HomeBank::call_hook", G_ARRAY);
 372         SPAGAIN;
 373         POPi;
 374         PUTBACK;
 375         FREETMPS;
 376         LEAVE;
 377 }
 378
 379
 380 static SV* val_to_sv(GValue* val)
 381 {
 382         if (!val || !G_IS_VALUE(val) || G_VALUE_TYPE(val) == G_TYPE_NONE) {
 383                 return &PL_sv_undef;
 384         }
 385         if (G_VALUE_TYPE(val) == G_TYPE_BOOLEAN) {
 386                 return newSVgboolean(g_value_get_boolean(val));
 387         }
 388         if (G_VALUE_TYPE(val) == G_TYPE_PTR_ARRAY) {
 389                 return newSVgptrarray((GPtrArray*)g_value_get_boxed(val));
 390         }
 391         if (G_VALUE_TYPE(val) == G_TYPE_HASH_TABLE) {
 392                 return newSVghashtable((GHashTable*)g_value_get_boxed(val));
 393         }
 394 #define obj(CTYPE, _2, PART, GTYPE, _5)                         \
 395         if (G_VALUE_TYPE(val) == GTYPE) {                           \
 396                 SV* sv = newSV(0);                                      \
 397                 CTYPE* ptr = (CTYPE*)g_value_get_##PART(val);           \
 398                 EXT_C2P_OBJECT("HomeBank::"#CTYPE, sv, rc_ref(ptr));    \
 399                 return sv;                                              \
 400         }
 401 #include "ext-value.h"
 402 #undef obj
 403         return gperl_sv_from_value(val, FALSE);
 404 }
 405
 406 static GValue* sv_to_val(SV* sv)
 407 {
 408         GValue* val = g_new0(GValue, 1);
 409
 410         if (SvUOK(sv)) return EXT_SV(val, sv, G_TYPE_UINT);
 411         if (SvIOK(sv)) return EXT_SV(val, sv, G_TYPE_INT);
 412         if (SvNOK(sv)) return EXT_SV(val, sv, G_TYPE_DOUBLE);
 413         if (SvPOK(sv)) return EXT_SV(val, sv, G_TYPE_STRING);
 414         if (sv_isobject(sv)) {
 415                 if (sv_derived_from(sv, "HomeBank::Boolean")) {
 416                         return EXT_BOOLEAN(val, SvGboolean(sv));
 417                 }
 418 #define obj(CTYPE, NAME, _3, _4, _5)                                \
 419                 if (sv_derived_from(sv, "HomeBank::"#CTYPE)) {              \
 420                         CTYPE* ptr;                                             \
 421                         EXT_P2C_OBJECT("HomeBank::"#CTYPE, sv, ptr, CTYPE*);    \
 422                         return EXT_##NAME(val, ptr);                            \
 423                 }
 424 #include "ext-value.h"
 425 #undef obj
 426                 return EXT_SV(val, sv, G_TYPE_OBJECT);
 427         }
 428         if (SvROK(sv)) {
 429                 sv = SvRV(sv);
 430                 switch (SvTYPE(sv)) {
 431                         case SVt_IV:
 432                                 return EXT_BOOLEAN(val, SvGboolean(sv));
 433                         case SVt_PVAV:
 434                                 return EXT_ARRAY(val, SvGptrarray(sv));
 435                         case SVt_PVHV:
 436                                 return EXT_HASH_TABLE(val, SvGhashtable(sv));
 437                         default:
 438                                 break;
 439                 }
 440         }
 441         switch (SvTYPE(sv)) {
 442                 case SVt_PVAV:
 443                         return EXT_ARRAY(val, SvGptrarray(sv));
 444                 case SVt_PVHV:
 445                         return EXT_HASH_TABLE(val, SvGhashtable(sv));
 446                 default:
 447                         break;
 448         }
 449
 450         g_free(val);
 451         return NULL;
 452 }
 453
 454
 455 static gboolean gperl_value_from_sv(GValue* value, SV* sv)
 456 {
 457         gboolean (*func)(GValue*, SV*) = ext_symbol_lookup("gperl_value_from_sv");
 458         if (func) return func(value, sv);
 459
 460         GType type = G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value));
 461         if (!SvOK(sv)) return TRUE;
 462         switch (type) {
 463                 case G_TYPE_CHAR:
 464                 {
 465                         gchar *tmp = SvGchar_ptr(sv);
 466                         g_value_set_schar(value, (gint8)(tmp ? tmp[0] : 0));
 467                         break;
 468                 }
 469                 case G_TYPE_UCHAR:
 470                 {
 471                         char *tmp = SvPV_nolen(sv);
 472                         g_value_set_uchar(value, (guchar)(tmp ? tmp[0] : 0));
 473                         break;
 474                 }
 475                 case G_TYPE_BOOLEAN:
 476                         g_value_set_boolean(value, SvTRUE(sv));
 477                         break;
 478                 case G_TYPE_INT:
 479                         g_value_set_int(value, SvIV(sv));
 480                         break;
 481                 case G_TYPE_UINT:
 482                         g_value_set_uint(value, SvIV(sv));
 483                         break;
 484                 case G_TYPE_LONG:
 485                         g_value_set_long(value, SvIV(sv));
 486                         break;
 487                 case G_TYPE_ULONG:
 488                         g_value_set_ulong(value, SvIV(sv));
 489                         break;
 490                 case G_TYPE_FLOAT:
 491                         g_value_set_float(value, (gfloat)SvNV(sv));
 492                         break;
 493                 case G_TYPE_DOUBLE:
 494                         g_value_set_double(value, SvNV(sv));
 495                         break;
 496                 case G_TYPE_STRING:
 497                         g_value_set_string(value, SvGchar_ptr(sv));
 498                         break;
 499         }
 500         return TRUE;
 501 }
 502
 503 static SV* gperl_sv_from_value(const GValue* value, gboolean copy_boxed)
 504 {
 505         SV* (*func)(const GValue*, gboolean) = ext_symbol_lookup("gperl_sv_from_value");
 506         if (func) return func(value, copy_boxed);
 507
 508         GType type = G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(value));
 509         switch (type) {
 510                 case G_TYPE_CHAR:
 511                         return newSViv(g_value_get_schar(value));
 512                 case G_TYPE_UCHAR:
 513                         return newSVuv(g_value_get_uchar(value));
 514                 case G_TYPE_BOOLEAN:
 515                         return newSViv(g_value_get_boolean(value));
 516                 case G_TYPE_INT:
 517                         return newSViv(g_value_get_int(value));
 518                 case G_TYPE_UINT:
 519                         return newSVuv(g_value_get_uint(value));
 520                 case G_TYPE_LONG:
 521                         return newSViv(g_value_get_long(value));
 522                 case G_TYPE_ULONG:
 523                         return newSVuv(g_value_get_ulong(value));
 524                 case G_TYPE_FLOAT:
 525                         return newSVnv(g_value_get_float(value));
 526                 case G_TYPE_DOUBLE:
 527                         return newSVnv(g_value_get_double(value));
 528                 case G_TYPE_STRING:
 529                         return newSVgchar_ptr(g_value_get_string(value));
 530         }
 531         return &PL_sv_undef;
 532 }
 533
 534
 535 static void _register(void) __attribute__((constructor));
 536 static void _register()
 537 {
 538         ext_register("perl",
 539                         ext_perl_init,
 540                         ext_perl_term,
 541                         ext_perl_check_file,
 542                         ext_perl_read_plugin_metadata,
 543                         ext_perl_load_plugin,
 544                         ext_perl_unload_plugin,
 545                         ext_perl_execute_action,
 546                         ext_perl_call_hook);
 547 }
 548
 549
 550 MODULE = HomeBank  PACKAGE = HomeBank
 551
 552 PROTOTYPES: ENABLE
 553
 554 const gchar*
 555 version(void)
 556         CODE:
 557                 RETVAL = VERSION;
 558         OUTPUT:
 559                 RETVAL
 560
 561 const gchar*
 562 config_dir(void)
 563         CODE:
 564                 RETVAL = homebank_app_get_config_dir();
 565         OUTPUT:
 566                 RETVAL
 567
 568 gboolean
 569 has(const gchar* CLASS, ...)
 570         PREINIT:
 571                 int i;
 572         CODE:
 573                 PERL_UNUSED_ARG(CLASS);
 574                 RETVAL = TRUE;
 575                 for (i = 1; i < items; ++i) {
 576                         gchar* feature = SvGchar_ptr(ST(i));
 577                         if (!feature || !ext_has(feature)) {
 578                                 RETVAL = FALSE;
 579                                 break;
 580                         }
 581                 }
 582         OUTPUT:
 583                 RETVAL
 584
 585 GObject*
 586 main_window(void)
 587         CODE:
 588                 RETVAL = G_OBJECT(GLOBALS->mainwindow);
 589         OUTPUT:
 590                 RETVAL
 591
 592 GObject*
 593 main_ui_manager(void)
 594         PREINIT:
 595                 struct hbfile_data *data;
 596         CODE:
 597                 RETVAL = NULL;
 598                 if (GLOBALS->mainwindow) {
 599                         data = g_object_get_data(G_OBJECT(gtk_widget_get_ancestor(GLOBALS->mainwindow, GTK_TYPE_WINDOW)), "inst_data");
 600                         if (data) {
 601                                 RETVAL = G_OBJECT(data->manager);
 602                         }
 603                 }
 604         OUTPUT:
 605                 RETVAL
 606
 607 void
 608 info(const gchar* CLASS, const gchar* title, const gchar* text)
 609         CODE:
 610                 PERL_UNUSED_ARG(CLASS);
 611                 ext_run_modal(title, text, "info");
 612
 613 void
 614 warn(const gchar* CLASS, const gchar* title, const gchar* text)
 615         CODE:
 616                 PERL_UNUSED_ARG(CLASS);
 617                 ext_run_modal(title, text, "warn");
 618
 619 void
 620 error(const gchar* CLASS, const gchar* title, const gchar* text)
 621         CODE:
 622                 PERL_UNUSED_ARG(CLASS);
 623                 ext_run_modal(title, text, "error");
 624
 625 void
 626 hook(const gchar* CLASS, const gchar* hook_name, ...)
 627         PREINIT:
 628                 int i;
 629                 GList* list = NULL;
 630         CODE:
 631                 PERL_UNUSED_ARG(CLASS);
 632                 for (i = 2; i < items; ++i) {
 633                         SV* sv = ST(i);
 634                         GValue *val = sv_to_val(sv);
 635                         list = g_list_append(list, val);
 636                 }
 637         CLEANUP:
 638                 ext_vhook(hook_name, list);
 639                 g_list_free(list);
 640                 // TODO free all the things
 641
 642 GObject*
 643 open_prefs(const gchar* CLASS)
 644         CODE:
 645                 PERL_UNUSED_ARG(CLASS);
 646                 RETVAL = G_OBJECT(defpref_dialog_new(PREF_GENERAL));
 647         OUTPUT:
 648                 RETVAL
 649
 650
 651 MODULE = HomeBank  PACKAGE = HomeBank::File
 652
 653 const gchar*
 654 owner(const gchar* CLASS, ...)
 655         CODE:
 656                 PERL_UNUSED_ARG(CLASS);
 657                 if (1 < items) {
 658                         hbfile_change_owner(g_strdup(SvGchar_ptr(ST(1))));
 659                 }
 660                 RETVAL = GLOBALS->owner;
 661         OUTPUT:
 662                 RETVAL
 663
 664 void
 665 transactions(const gchar* CLASS)
 666         PPCODE:
 667                 PERL_UNUSED_ARG(CLASS);
 668
 669                 GList* acc_list = g_hash_table_get_values(GLOBALS->h_acc);
 670                 GList* acc_link = g_list_first(acc_list);
 671                 for (; acc_link; acc_link = g_list_next(acc_link)) {
 672                         Account *acc = acc_link->data;
 673
 674                         GList* txn_link = g_queue_peek_head_link(acc->txn_queue);
 675                         for (; txn_link; txn_link = g_list_next(txn_link)) {
 676                                 Transaction* txn = txn_link->data;
 677
 678                                 GValue val = G_VALUE_INIT;
 679                                 SV* sv = val_to_sv(EXT_TRANSACTION(&val, txn));
 680                                 mXPUSHs(sv);
 681                         }
 682                 }
 683
 684                 g_list_free(acc_list);
 685
 686 void
 687 anonymize(void)
 688         CODE:
 689                 hbfile_anonymize();
 690
 691 void
 692 baz(const gchar* CLASS, Account* account)
 693         CODE:
 694                 PERL_UNUSED_ARG(CLASS);
 695                 g_print("hello: %s\n", account->name);
 696
 697 GPtrArray*
 698 meh(const gchar* CLASS, GPtrArray* asdf)
 699         CODE:
 700                 PERL_UNUSED_ARG(CLASS);
 701                 g_print("WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW\n");
 702                 if (asdf) {
 703                         ;
 704                 } else {
 705                         g_print("the array is nil\n");
 706                 }
 707                 RETVAL = asdf;
 708         OUTPUT:
 709                 RETVAL
 710         CLEANUP:
 711                 g_ptr_array_unref(asdf);
 712
 713 GHashTable*
 714 foo(const gchar* CLASS, GHashTable* asdf)
 715         CODE:
 716                 PERL_UNUSED_ARG(CLASS);
 717                 g_print("WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW\n");
 718                 if (asdf) {
 719                         GHashTableIter it;
 720                         g_hash_table_iter_init(&it, asdf);
 721                         gchar* key = NULL;
 722                         GValue* item = NULL;
 723                         while (g_hash_table_iter_next(&it, (gpointer*)&key, (gpointer*)&item)) {
 724                                 g_print("hash with key: %s\n", key);
 725                         }
 726                 } else {
 727                         g_print("the hash is nil\n");
 728                 }
 729                 RETVAL = asdf;
 730         OUTPUT:
 731                 RETVAL
 732         CLEANUP:
 733                 g_hash_table_unref(asdf);
 734
 735
 736 MODULE = HomeBank  PACKAGE = HomeBank::Account
 737
 738 void
 739 compute_balances(const gchar* CLASS)
 740         CODE:
 741                 PERL_UNUSED_ARG(CLASS);
 742                 account_compute_balances();
 743
 744 Account*
 745 new(void)
 746         CODE:
 747                 RETVAL = da_acc_malloc();
 748         OUTPUT:
 749                 RETVAL
 750
 751 void
 752 DESTROY(Account* SELF)
 753         CODE:
 754                 da_acc_free(SELF);
 755
 756 Account*
 757 get(const gchar* CLASS, guint key)
 758         CODE:
 759                 PERL_UNUSED_ARG(CLASS);
 760                 RETVAL = rc_ref(da_acc_get(key));
 761         OUTPUT:
 762                 RETVAL
 763
 764 Account*
 765 get_by_name(const gchar* CLASS, const gchar* name)
 766         CODE:
 767                 PERL_UNUSED_ARG(CLASS);
 768                 RETVAL = rc_ref(da_acc_get_by_name((gchar*)name));
 769         OUTPUT:
 770                 RETVAL
 771
 772 const gchar*
 773 name(Account* SELF, ...)
 774         CODE:
 775                 if (1 < items) {
 776                         account_rename(SELF, SvGchar_ptr(ST(1)));
 777                 }
 778                 RETVAL = SELF->name;
 779         OUTPUT:
 780                 RETVAL
 781
 782 const gchar*
 783 number(Account* SELF, ...)
 784         CODE:
 785                 if (1 < items) {
 786                         g_free(SELF->number);
 787                         SELF->number = g_strdup(SvGchar_ptr(ST(1)));
 788                 }
 789                 RETVAL = SELF->number;
 790         OUTPUT:
 791                 RETVAL
 792
 793 const gchar*
 794 bankname(Account* SELF, ...)
 795         CODE:
 796                 if (1 < items) {
 797                         g_free(SELF->bankname);
 798                         SELF->bankname = g_strdup(SvGchar_ptr(ST(1)));
 799                 }
 800                 RETVAL = SELF->bankname;
 801         OUTPUT:
 802                 RETVAL
 803
 804 gdouble
 805 initial(Account* SELF, ...)
 806         CODE:
 807                 if (1 < items) {
 808                         SELF->initial = SvNV(ST(1));
 809                 }
 810                 RETVAL = SELF->initial;
 811         OUTPUT:
 812                 RETVAL
 813
 814 gdouble
 815 minimum(Account* SELF, ...)
 816         CODE:
 817                 if (1 < items) {
 818                         SELF->minimum = SvNV(ST(1));
 819                 }
 820                 RETVAL = SELF->minimum;
 821         OUTPUT:
 822                 RETVAL
 823
 824 guint
 825 cheque1(Account* SELF, ...)
 826         ALIAS:
 827                 check1 = 1
 828         CODE:
 829                 PERL_UNUSED_VAR(ix);
 830                 if (1 < items) {
 831                         SELF->cheque1 = SvUV(ST(1));
 832                 }
 833                 RETVAL = SELF->cheque1;
 834         OUTPUT:
 835                 RETVAL
 836
 837 guint
 838 cheque2(Account* SELF, ...)
 839         ALIAS:
 840                 check2 = 1
 841         CODE:
 842                 PERL_UNUSED_VAR(ix);
 843                 if (1 < items) {
 844                         SELF->cheque2 = SvUV(ST(1));
 845                 }
 846                 RETVAL = SELF->cheque2;
 847         OUTPUT:
 848                 RETVAL
 849
 850 gdouble
 851 balance(Account* SELF)
 852         ALIAS:
 853                 bank_balance    = 1
 854                 future_balance  = 2
 855         CODE:
 856                 switch (ix) {
 857                         case 1:
 858                                 RETVAL = SELF->bal_bank;
 859                                 break;
 860                         case 2:
 861                                 RETVAL = SELF->bal_future;
 862                                 break;
 863                         default:
 864                                 RETVAL = SELF->bal_today;
 865                                 break;
 866                 }
 867         OUTPUT:
 868                 RETVAL
 869
 870 gboolean
 871 is_inserted(Account* SELF)
 872         CODE:
 873                 RETVAL = da_acc_get(SELF->key) == SELF;
 874         OUTPUT:
 875                 RETVAL
 876
 877 gboolean
 878 is_used(Account* SELF)
 879         CODE:
 880                 RETVAL = account_is_used(SELF->key);
 881         OUTPUT:
 882                 RETVAL
 883
 884 gboolean
 885 insert(Account* SELF)
 886         CODE:
 887                 if (SELF->key == 0 || account_is_used(SELF->key))
 888                         RETVAL = da_acc_append(rc_ref(SELF));
 889                 else
 890                         RETVAL = da_acc_insert(rc_ref(SELF));
 891         OUTPUT:
 892                 RETVAL
 893
 894 void
 895 remove(Account* SELF)
 896         CODE:
 897                 da_acc_remove(SELF->key);
 898
 899 void
 900 transactions(Account* SELF)
 901         PPCODE:
 902                 GList* list = g_queue_peek_head_link(SELF->txn_queue);
 903                 for (; list; list = g_list_next(list)) {
 904                         Transaction* txn = list->data;
 905                         GValue val = G_VALUE_INIT;
 906                         SV* sv = val_to_sv(EXT_TRANSACTION(&val, txn));
 907                         mXPUSHs(sv);
 908                 }
 909
 910 GObject*
 911 open(Account* SELF)
 912         CODE:
 913                 RETVAL = G_OBJECT(register_panel_window_new(SELF->key, SELF));
 914         OUTPUT:
 915                 RETVAL
 916
 917
 918 MODULE = HomeBank  PACKAGE = HomeBank::Transaction
 919
 920 Transaction*
 921 new(void)
 922         CODE:
 923                 RETVAL = da_transaction_malloc();
 924         OUTPUT:
 925                 RETVAL
 926
 927 void
 928 DESTROY(Transaction* SELF)
 929         CODE:
 930                 da_transaction_free(SELF);
 931
 932 gdouble
 933 amount(Transaction* SELF, ...)
 934         CODE:
 935                 if (1 < items) {
 936                         SELF->amount = SvNV(ST(1));
 937                 }
 938                 RETVAL = SELF->amount;
 939         OUTPUT:
 940                 RETVAL
 941
 942 guint
 943 account_num(Transaction* SELF, ...)
 944         CODE:
 945                 if (1 < items) {
 946                         SELF->kacc = SvIV(ST(1));
 947                 }
 948                 RETVAL = SELF->kacc;
 949         OUTPUT:
 950                 RETVAL
 951
 952 guint
 953 paired_account_num(Transaction* SELF, ...)
 954         CODE:
 955                 if (1 < items) {
 956                         SELF->kxferacc = SvIV(ST(1));
 957                 }
 958                 RETVAL = SELF->kxferacc;
 959         OUTPUT:
 960                 RETVAL
 961
 962 void
 963 date(Transaction* SELF, ...)
 964         PPCODE:
 965                 if (1 < items) {
 966                         SELF->date = SvIV(ST(1));
 967                 }
 968                 if (GIMME_V == G_ARRAY) {
 969                         GDate* d = g_date_new_julian(SELF->date);
 970                         mXPUSHp("day", 3);
 971                         mXPUSHi(g_date_get_day(d));
 972                         mXPUSHp("month", 5);
 973                         mXPUSHi(g_date_get_month(d));
 974                         mXPUSHp("year", 4);
 975                         mXPUSHi(g_date_get_year(d));
 976                         g_date_free(d);
 977                         XSRETURN(6);
 978                 } else {
 979                         XSRETURN_IV(SELF->date);
 980                 }
 981
 982 const gchar*
 983 wording(Transaction* SELF, ...)
 984         CODE:
 985                 if (1 < items) {
 986                         if (SELF->wording) g_free(SELF->wording);
 987                         SELF->wording = g_strdup(SvGchar_ptr(ST(1)));
 988                 }
 989                 RETVAL = SELF->wording ? SELF->wording : "";
 990         OUTPUT:
 991                 RETVAL
 992
 993 const gchar*
 994 info(Transaction* SELF, ...)
 995         CODE:
 996                 if (1 < items) {
 997                         if (SELF->info) g_free(SELF->info);
 998                         SELF->info = g_strdup(SvGchar_ptr(ST(1)));
 999                 }
1000                 RETVAL = SELF->info ? SELF->info : "";
1001         OUTPUT:
1002                 RETVAL
1003
1004 GObject*
1005 open(Transaction* SELF)
1006         CODE:
1007                 RETVAL = G_OBJECT(create_deftransaction_window(NULL, TRANSACTION_EDIT_MODIFY, FALSE));
1008                 deftransaction_set_transaction(GTK_WIDGET(RETVAL), SELF);
1009         OUTPUT:
1010                 RETVAL
1011
1012 Transaction*
1013 pair_with(Transaction* SELF, Transaction* other, ...)
1014         PREINIT:
1015                 int i;
1016                 GList* list = NULL;
1017         CODE:
1018                 if (2 < items) {
1019                         list = g_list_append(list, other);
1020                         for (i = 2; i < items; ++i) {
1021                                 Transaction* ptr = NULL;
1022                                 SV* sv = ST(i);
1023                                 EXT_P2C_OBJECT("HomeBank::Transaction", sv, ptr, Transaction*);
1024                                 list = g_list_append(list, ptr);
1025                         }
1026                         other = ui_dialog_transaction_xfer_select_child(SELF, list);
1027                 }
1028                 if (other) {
1029                         transaction_xfer_change_to_child(SELF, other);
1030                         SELF->paymode = PAYMODE_INTXFER;
1031                 }
1032                 RETVAL = other;
1033         OUTPUT:
1034                 RETVAL
1035         CLEANUP:
1036                 g_list_free(list);
1037
1038 void
1039 dump(Transaction* SELF)
1040         CODE:
1041                 g_print("txn: %p (%s) at %u (%d/%d) flags:%d, paymode:%d, kpay:%d, kcat:%d", SELF,
1042                         SELF->wording, SELF->date, SELF->kacc, SELF->kxferacc, SELF->flags, SELF->paymode, SELF->kpay, SELF->kcat);
1043