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                 GList* list = g_list_first(GLOBALS->ope_list);
 669                 for (; list; list = g_list_next(list)) {
 670                         GValue val = G_VALUE_INIT;
 671                         SV* sv = val_to_sv(EXT_TRANSACTION(&val, list->data));
 672                         mXPUSHs(sv);
 673                 }
 674
 675 void
 676 anonymize(void)
 677         CODE:
 678                 hbfile_anonymize();
 679
 680 void
 681 baz(const gchar* CLASS, Account* account)
 682         CODE:
 683                 PERL_UNUSED_ARG(CLASS);
 684                 g_print("hello: %s\n", account->name);
 685
 686 GPtrArray*
 687 meh(const gchar* CLASS, GPtrArray* asdf)
 688         CODE:
 689                 PERL_UNUSED_ARG(CLASS);
 690                 g_print("WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW\n");
 691                 if (asdf) {
 692                         ;
 693                 } else {
 694                         g_print("the array is nil\n");
 695                 }
 696                 RETVAL = asdf;
 697         OUTPUT:
 698                 RETVAL
 699         CLEANUP:
 700                 g_ptr_array_unref(asdf);
 701
 702 GHashTable*
 703 foo(const gchar* CLASS, GHashTable* asdf)
 704         CODE:
 705                 PERL_UNUSED_ARG(CLASS);
 706                 g_print("WWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWW\n");
 707                 if (asdf) {
 708                         GHashTableIter it;
 709                         g_hash_table_iter_init(&it, asdf);
 710                         gchar* key = NULL;
 711                         GValue* item = NULL;
 712                         while (g_hash_table_iter_next(&it, (gpointer*)&key, (gpointer*)&item)) {
 713                                 g_print("hash with key: %s\n", key);
 714                         }
 715                 } else {
 716                         g_print("the hash is nil\n");
 717                 }
 718                 RETVAL = asdf;
 719         OUTPUT:
 720                 RETVAL
 721         CLEANUP:
 722                 g_hash_table_unref(asdf);
 723
 724
 725 MODULE = HomeBank  PACKAGE = HomeBank::Account
 726
 727 void
 728 compute_balances(const gchar* CLASS)
 729         CODE:
 730                 PERL_UNUSED_ARG(CLASS);
 731                 account_compute_balances();
 732
 733 Account*
 734 new(void)
 735         CODE:
 736                 RETVAL = da_acc_malloc();
 737         OUTPUT:
 738                 RETVAL
 739
 740 Account*
 741 clone(Account* SELF)
 742         CODE:
 743                 RETVAL = da_acc_clone(SELF);
 744                 RETVAL->key = 0;
 745         OUTPUT:
 746                 RETVAL
 747
 748 void
 749 DESTROY(Account* SELF)
 750         CODE:
 751                 da_acc_free(SELF);
 752
 753 Account*
 754 get(const gchar* CLASS, guint key)
 755         CODE:
 756                 PERL_UNUSED_ARG(CLASS);
 757                 RETVAL = rc_ref(da_acc_get(key));
 758         OUTPUT:
 759                 RETVAL
 760
 761 Account*
 762 get_by_name(const gchar* CLASS, const gchar* name)
 763         CODE:
 764                 PERL_UNUSED_ARG(CLASS);
 765                 RETVAL = rc_ref(da_acc_get_by_name((gchar*)name));
 766         OUTPUT:
 767                 RETVAL
 768
 769 const gchar*
 770 name(Account* SELF, ...)
 771         CODE:
 772                 if (1 < items) {
 773                         account_rename(SELF, SvGchar_ptr(ST(1)));
 774                 }
 775                 RETVAL = SELF->name;
 776         OUTPUT:
 777                 RETVAL
 778
 779 const gchar*
 780 number(Account* SELF, ...)
 781         CODE:
 782                 if (1 < items) {
 783                         g_free(SELF->number);
 784                         SELF->number = g_strdup(SvGchar_ptr(ST(1)));
 785                 }
 786                 RETVAL = SELF->number;
 787         OUTPUT:
 788                 RETVAL
 789
 790 const gchar*
 791 bankname(Account* SELF, ...)
 792         CODE:
 793                 if (1 < items) {
 794                         g_free(SELF->bankname);
 795                         SELF->bankname = g_strdup(SvGchar_ptr(ST(1)));
 796                 }
 797                 RETVAL = SELF->bankname;
 798         OUTPUT:
 799                 RETVAL
 800
 801 gdouble
 802 initial(Account* SELF, ...)
 803         CODE:
 804                 if (1 < items) {
 805                         SELF->initial = SvNV(ST(1));
 806                 }
 807                 RETVAL = SELF->initial;
 808         OUTPUT:
 809                 RETVAL
 810
 811 gdouble
 812 minimum(Account* SELF, ...)
 813         CODE:
 814                 if (1 < items) {
 815                         SELF->minimum = SvNV(ST(1));
 816                 }
 817                 RETVAL = SELF->minimum;
 818         OUTPUT:
 819                 RETVAL
 820
 821 guint
 822 cheque1(Account* SELF, ...)
 823         ALIAS:
 824                 check1 = 1
 825         CODE:
 826                 PERL_UNUSED_VAR(ix);
 827                 if (1 < items) {
 828                         SELF->cheque1 = SvUV(ST(1));
 829                 }
 830                 RETVAL = SELF->cheque1;
 831         OUTPUT:
 832                 RETVAL
 833
 834 guint
 835 cheque2(Account* SELF, ...)
 836         ALIAS:
 837                 check2 = 1
 838         CODE:
 839                 PERL_UNUSED_VAR(ix);
 840                 if (1 < items) {
 841                         SELF->cheque2 = SvUV(ST(1));
 842                 }
 843                 RETVAL = SELF->cheque2;
 844         OUTPUT:
 845                 RETVAL
 846
 847 gdouble
 848 balance(Account* SELF)
 849         ALIAS:
 850                 bank_balance    = 1
 851                 future_balance  = 2
 852         CODE:
 853                 switch (ix) {
 854                         case 1:
 855                                 RETVAL = SELF->bal_bank;
 856                                 break;
 857                         case 2:
 858                                 RETVAL = SELF->bal_future;
 859                                 break;
 860                         default:
 861                                 RETVAL = SELF->bal_today;
 862                                 break;
 863                 }
 864         OUTPUT:
 865                 RETVAL
 866
 867 gboolean
 868 is_inserted(Account* SELF)
 869         CODE:
 870                 RETVAL = da_acc_get(SELF->key) == SELF;
 871         OUTPUT:
 872                 RETVAL
 873
 874 gboolean
 875 is_used(Account* SELF)
 876         CODE:
 877                 RETVAL = account_is_used(SELF->key);
 878         OUTPUT:
 879                 RETVAL
 880
 881 gboolean
 882 insert(Account* SELF)
 883         CODE:
 884                 if (SELF->key == 0 || account_is_used(SELF->key))
 885                         RETVAL = da_acc_append(rc_ref(SELF));
 886                 else
 887                         RETVAL = da_acc_insert(rc_ref(SELF));
 888         OUTPUT:
 889                 RETVAL
 890
 891 void
 892 remove(Account* SELF)
 893         CODE:
 894                 da_acc_remove(SELF->key);
 895
 896 void
 897 transactions(Account* SELF)
 898         PPCODE:
 899                 GList* list = g_list_first(GLOBALS->ope_list);
 900                 for (; list; list = g_list_next(list)) {
 901                         Transaction* txn = list->data;
 902                         if (txn->kacc == SELF->key) {
 903                                 GValue val = G_VALUE_INIT;
 904                                 SV* sv = val_to_sv(EXT_TRANSACTION(&val, txn));
 905                                 mXPUSHs(sv);
 906                         }
 907                 }
 908
 909 GObject*
 910 open(Account* SELF)
 911         CODE:
 912                 RETVAL = G_OBJECT(register_panel_window_new(SELF->key, SELF));
 913         OUTPUT:
 914                 RETVAL
 915
 916
 917 MODULE = HomeBank  PACKAGE = HomeBank::Transaction
 918
 919 Transaction*
 920 new(void)
 921         CODE:
 922                 RETVAL = da_transaction_malloc();
 923         OUTPUT:
 924                 RETVAL
 925
 926 void
 927 DESTROY(Transaction* SELF)
 928         CODE:
 929                 da_transaction_free(SELF);
 930
 931 gdouble
 932 amount(Transaction* SELF, ...)
 933         CODE:
 934                 if (1 < items) {
 935                         SELF->amount = SvNV(ST(1));
 936                 }
 937                 RETVAL = SELF->amount;
 938         OUTPUT:
 939                 RETVAL
 940
 941 guint
 942 account_num(Transaction* SELF, ...)
 943         CODE:
 944                 if (1 < items) {
 945                         SELF->kacc = SvIV(ST(1));
 946                 }
 947                 RETVAL = SELF->kacc;
 948         OUTPUT:
 949                 RETVAL
 950
 951 guint
 952 paired_account_num(Transaction* SELF, ...)
 953         CODE:
 954                 if (1 < items) {
 955                         SELF->kxferacc = SvIV(ST(1));
 956                 }
 957                 RETVAL = SELF->kxferacc;
 958         OUTPUT:
 959                 RETVAL
 960
 961 void
 962 date(Transaction* SELF, ...)
 963         PPCODE:
 964                 if (1 < items) {
 965                         SELF->date = SvIV(ST(1));
 966                 }
 967                 if (GIMME_V == G_ARRAY) {
 968                         GDate* d = g_date_new_julian(SELF->date);
 969                         mXPUSHp("day", 3);
 970                         mXPUSHi(g_date_get_day(d));
 971                         mXPUSHp("month", 5);
 972                         mXPUSHi(g_date_get_month(d));
 973                         mXPUSHp("year", 4);
 974                         mXPUSHi(g_date_get_year(d));
 975                         g_date_free(d);
 976                         XSRETURN(6);
 977                 } else {
 978                         XSRETURN_IV(SELF->date);
 979                 }
 980
 981 const gchar*
 982 wording(Transaction* SELF, ...)
 983         CODE:
 984                 if (1 < items) {
 985                         if (SELF->wording) g_free(SELF->wording);
 986                         SELF->wording = g_strdup(SvGchar_ptr(ST(1)));
 987                 }
 988                 RETVAL = SELF->wording ? SELF->wording : "";
 989         OUTPUT:
 990                 RETVAL
 991
 992 const gchar*
 993 info(Transaction* SELF, ...)
 994         CODE:
 995                 if (1 < items) {
 996                         if (SELF->info) g_free(SELF->info);
 997                         SELF->info = g_strdup(SvGchar_ptr(ST(1)));
 998                 }
 999                 RETVAL = SELF->info ? SELF->info : "";
1000         OUTPUT:
1001                 RETVAL
1002
1003 GObject*
1004 open(Transaction* SELF)
1005         CODE:
1006                 RETVAL = G_OBJECT(create_deftransaction_window(NULL, TRANSACTION_EDIT_MODIFY));
1007                 deftransaction_set_transaction(GTK_WIDGET(RETVAL), SELF);
1008         OUTPUT:
1009                 RETVAL
1010
1011 Transaction*
1012 pair_with(Transaction* SELF, Transaction* other, ...)
1013         PREINIT:
1014                 int i;
1015                 GList* list = NULL;
1016         CODE:
1017                 if (2 < items) {
1018                         list = g_list_append(list, other);
1019                         for (i = 2; i < items; ++i) {
1020                                 Transaction* ptr = NULL;
1021                                 SV* sv = ST(i);
1022                                 EXT_P2C_OBJECT("HomeBank::Transaction", sv, ptr, Transaction*);
1023                                 list = g_list_append(list, ptr);
1024                         }
1025                         other = ui_dialog_transaction_xfer_select_child(list);
1026                 }
1027                 if (other) {
1028                         transaction_xfer_change_to_child(SELF, other);
1029                         SELF->paymode = PAYMODE_INTXFER;
1030                 }
1031                 RETVAL = other;
1032         OUTPUT:
1033                 RETVAL
1034         CLEANUP:
1035                 g_list_free(list);
1036
1037 void
1038 dump(Transaction* SELF)
1039         CODE:
1040                 g_print("txn: %p (%s) at %u (%d/%d) flags:%d, paymode:%d, kpay:%d, kcat:%d", SELF,
1041                         SELF->wording, SELF->date, SELF->kacc, SELF->kxferacc, SELF->flags, SELF->paymode, SELF->kpay, SELF->kcat);
1042