src/PVE/RESTHandler.pm

   1 package PVE::RESTHandler;
   2
   3 use strict;
   4 no strict 'refs'; # our autoload requires this
   5 use warnings;
   6 use PVE::SafeSyslog;
   7 use PVE::Exception qw(raise raise_param_exc);
   8 use PVE::JSONSchema;
   9 use HTTP::Status qw(:constants :is status_message);
  10 use Text::Wrap;
  11 use Clone qw(clone);
  12
  13 my $method_registry = {};
  14 my $method_by_name = {};
  15 my $method_path_lookup = {};
  16
  17 our $AUTOLOAD;  # it's a package global
  18
  19 sub api_clone_schema {
  20     my ($schema) = @_;
  21
  22     my $res = {};
  23     my $ref = ref($schema);
  24     die "not a HASH reference" if !($ref && $ref eq 'HASH');
  25
  26     foreach my $k (keys %$schema) {
  27         my $d = $schema->{$k};
  28         if ($k ne 'properties') {
  29             $res->{$k} = ref($d) ? clone($d) : $d;
  30             next;
  31         }
  32         # convert indexed parameters like -net\d+ to -net[n]
  33         foreach my $p (keys %$d) {
  34             my $pd = $d->{$p};
  35             if ($p =~ m/^([a-z]+)(\d+)$/) {
  36                 my ($name, $idx) = ($1, $2);
  37                 if ($idx == 0 && defined($d->{"${name}1"})) {
  38                     $p = "${name}[n]";
  39                 } elsif (defined($d->{"${name}0"})) {
  40                     next; # only handle once for -xx0, but only if -xx0 exists
  41                 }
  42             }
  43             my $tmp = ref($pd) ? clone($pd) : $pd;
  44             # NOTE: add typetext property for more complex types, to
  45             # make the web api viewer code simpler
  46             if (!(defined($tmp->{enum}) || defined($tmp->{pattern}))) {
  47                 my $typetext = PVE::JSONSchema::schema_get_type_text($tmp);
  48                 if ($tmp->{type} && ($tmp->{type} ne $typetext)) {
  49                     $tmp->{typetext} = $typetext;
  50                 }
  51             }
  52             $res->{$k}->{$p} = $tmp;
  53         }
  54     }
  55
  56     return $res;
  57 }
  58
  59 sub api_dump_full {
  60     my ($tree, $index, $class, $prefix) = @_;
  61
  62     $prefix = '' if !$prefix;
  63
  64     my $ma = $method_registry->{$class};
  65
  66     foreach my $info (@$ma) {
  67
  68         my $path = "$prefix/$info->{path}";
  69         $path =~ s/\/+$//;
  70
  71         if ($info->{subclass}) {
  72             api_dump_full($tree, $index, $info->{subclass}, $path);
  73         } else {
  74             next if !$path;
  75
  76             # check if method is unique
  77             my $realpath = $path;
  78             $realpath =~ s/\{[^\}]+\}/\{\}/g;
  79             my $fullpath = "$info->{method} $realpath";
  80             die "duplicate path '$realpath'" if $index->{$fullpath};
  81             $index->{$fullpath} = $info;
  82
  83             # insert into tree
  84             my $treedir = $tree;
  85             my $res;
  86             my $sp = '';
  87             foreach my $dir (split('/', $path)) {
  88                 next if !$dir;
  89                 $sp .= "/$dir";
  90                 $res = (grep { $_->{text} eq $dir } @$treedir)[0];
  91                 if ($res) {
  92                     $res->{children} = [] if !$res->{children};
  93                     $treedir = $res->{children};
  94                 } else {
  95                     $res = {
  96                         path => $sp,
  97                         text => $dir,
  98                         children => [],
  99                     };
 100                     push @$treedir, $res;
 101                     $treedir = $res->{children};
 102                 }
 103             }
 104
 105             if ($res) {
 106                 my $data = {};
 107                 foreach my $k (keys %$info) {
 108                     next if $k eq 'code' || $k eq "match_name" || $k eq "match_re" ||
 109                         $k eq "path";
 110
 111                     my $d = $info->{$k};
 112
 113                     if ($k eq 'parameters') {
 114                         $data->{$k} = api_clone_schema($d);
 115                     } else {
 116
 117                         $data->{$k} = ref($d) ? clone($d) : $d;
 118                     }
 119                 }
 120                 $res->{info}->{$info->{method}} = $data;
 121             };
 122         }
 123     }
 124 };
 125
 126 sub api_dump_cleanup_tree {
 127     my ($tree) = @_;
 128
 129     foreach my $rec (@$tree) {
 130         delete $rec->{children} if $rec->{children} && !scalar(@{$rec->{children}});
 131         if ($rec->{children}) {
 132             $rec->{leaf} = 0;
 133             api_dump_cleanup_tree($rec->{children});
 134         } else {
 135             $rec->{leaf} = 1;
 136         }
 137     }
 138
 139 }
 140
 141 sub api_dump {
 142     my ($class, $prefix) = @_;
 143
 144     my $tree = [];
 145
 146     my $index = {};
 147     api_dump_full($tree, $index, $class);
 148     api_dump_cleanup_tree($tree);
 149     return $tree;
 150 };
 151
 152 sub validate_method_schemas {
 153
 154     foreach my $class (keys %$method_registry) {
 155         my $ma = $method_registry->{$class};
 156
 157         foreach my $info (@$ma) {
 158             PVE::JSONSchema::validate_method_info($info);
 159         }
 160     }
 161 }
 162
 163 sub register_method {
 164     my ($self, $info) = @_;
 165
 166     my $match_re = [];
 167     my $match_name = [];
 168
 169     my $errprefix;
 170
 171     my $method;
 172     if ($info->{subclass}) {
 173         $errprefix = "register subclass $info->{subclass} at ${self}/$info->{path} -";
 174         $method = 'SUBCLASS';
 175     } else {
 176         $errprefix = "register method ${self}/$info->{path} -";
 177         $info->{method} = 'GET' if !$info->{method};
 178         $method = $info->{method};
 179     }
 180
 181     $method_path_lookup->{$self} = {} if !defined($method_path_lookup->{$self});
 182     my $path_lookup = $method_path_lookup->{$self};
 183
 184     die "$errprefix no path" if !defined($info->{path});
 185
 186     foreach my $comp (split(/\/+/, $info->{path})) {
 187         die "$errprefix path compoment has zero length\n" if $comp eq '';
 188         my ($name, $regex);
 189         if ($comp =~ m/^\{(\w+)(:(.*))?\}$/) {
 190             $name = $1;
 191             $regex = $3 ? $3 : '\S+';
 192             push @$match_re, $regex;
 193             push @$match_name, $name;
 194         } else {
 195             $name = $comp;
 196             push @$match_re, $name;
 197             push @$match_name, undef;
 198         }
 199
 200         if ($regex) {
 201             $path_lookup->{regex} = {} if !defined($path_lookup->{regex});
 202
 203             my $old_name = $path_lookup->{regex}->{match_name};
 204             die "$errprefix found changed regex match name\n"
 205                 if defined($old_name) && ($old_name ne $name);
 206             my $old_re = $path_lookup->{regex}->{match_re};
 207             die "$errprefix found changed regex\n"
 208                 if defined($old_re) && ($old_re ne $regex);
 209             $path_lookup->{regex}->{match_name} = $name;
 210             $path_lookup->{regex}->{match_re} = $regex;
 211
 212             die "$errprefix path match error - regex and fixed items\n"
 213                 if defined($path_lookup->{folders});
 214
 215             $path_lookup = $path_lookup->{regex};
 216
 217         } else {
 218             $path_lookup->{folders}->{$name} = {} if !defined($path_lookup->{folders}->{$name});
 219
 220             die "$errprefix path match error - regex and fixed items\n"
 221                 if defined($path_lookup->{regex});
 222
 223             $path_lookup = $path_lookup->{folders}->{$name};
 224         }
 225     }
 226
 227     die "$errprefix duplicate method definition\n"
 228         if defined($path_lookup->{$method});
 229
 230     if ($method eq 'SUBCLASS') {
 231         foreach my $m (qw(GET PUT POST DELETE)) {
 232             die "$errprefix duplicate method definition SUBCLASS and $m\n" if $path_lookup->{$m};
 233         }
 234     }
 235     $path_lookup->{$method} = $info;
 236
 237     $info->{match_re} = $match_re;
 238     $info->{match_name} = $match_name;
 239
 240     $method_by_name->{$self} = {} if !defined($method_by_name->{$self});
 241
 242     if ($info->{name}) {
 243         die "$errprefix method name already defined\n"
 244             if defined($method_by_name->{$self}->{$info->{name}});
 245
 246         $method_by_name->{$self}->{$info->{name}} = $info;
 247     }
 248
 249     push @{$method_registry->{$self}}, $info;
 250 }
 251
 252 sub register_page_formatter {
 253     my ($self, %config) = @_;
 254
 255     my $format = $config{format} ||
 256         die "missing format";
 257
 258     my $path = $config{path} ||
 259         die "missing path";
 260
 261     my $method = $config{method} ||
 262         die "missing method";
 263
 264     my $code = $config{code} ||
 265         die "missing formatter code";
 266
 267     my $uri_param = {};
 268     my ($handler, $info) = $self->find_handler($method, $path, $uri_param);
 269     die "unabe to find handler for '$method: $path'" if !($handler && $info);
 270
 271     die "duplicate formatter for '$method: $path'"
 272         if $info->{formatter} && $info->{formatter}->{$format};
 273
 274     $info->{formatter}->{$format} = $code;
 275 }
 276
 277 sub DESTROY {}; # avoid problems with autoload
 278
 279 sub AUTOLOAD {
 280     my ($this) = @_;
 281
 282     # also see "man perldiag"
 283
 284     my $sub = $AUTOLOAD;
 285     (my $method = $sub) =~ s/.*:://;
 286
 287     my $info = $this->map_method_by_name($method);
 288
 289     *{$sub} = sub {
 290         my $self = shift;
 291         return $self->handle($info, @_);
 292     };
 293     goto &$AUTOLOAD;
 294 }
 295
 296 sub method_attributes {
 297     my ($self) = @_;
 298
 299     return $method_registry->{$self};
 300 }
 301
 302 sub map_method_by_name {
 303     my ($self, $name) = @_;
 304
 305     my $info = $method_by_name->{$self}->{$name};
 306     die "no such method '${self}::$name'\n" if !$info;
 307
 308     return $info;
 309 }
 310
 311 sub map_path_to_methods {
 312     my ($class, $stack, $uri_param, $pathmatchref) = @_;
 313
 314     my $path_lookup = $method_path_lookup->{$class};
 315
 316     # Note: $pathmatchref can be used to obtain path including
 317     # uri patterns like '/cluster/firewall/groups/{group}'.
 318     # Used by pvesh to display help
 319     if (defined($pathmatchref)) {
 320         $$pathmatchref = '' if !$$pathmatchref;
 321     }
 322
 323     while (defined(my $comp = shift @$stack)) {
 324         return undef if !$path_lookup; # not registerd?
 325         if ($path_lookup->{regex}) {
 326             my $name = $path_lookup->{regex}->{match_name};
 327             my $regex = $path_lookup->{regex}->{match_re};
 328
 329             return undef if $comp !~ m/^($regex)$/;
 330             $uri_param->{$name} = $1;
 331             $path_lookup = $path_lookup->{regex};
 332             $$pathmatchref .= '/{' . $name . '}' if defined($pathmatchref);
 333         } elsif ($path_lookup->{folders}) {
 334             $path_lookup = $path_lookup->{folders}->{$comp};
 335             $$pathmatchref .= '/' . $comp if defined($pathmatchref);
 336         } else {
 337             die "internal error";
 338         }
 339
 340         return undef if !$path_lookup;
 341
 342         if (my $info = $path_lookup->{SUBCLASS}) {
 343             $class = $info->{subclass};
 344
 345             my $fd = $info->{fragmentDelimiter};
 346
 347             if (defined($fd)) {
 348                 # we only support the empty string '' (match whole URI)
 349                 die "unsupported fragmentDelimiter '$fd'"
 350                     if $fd ne '';
 351
 352                 $stack = [ join ('/', @$stack) ] if scalar(@$stack) > 1;
 353             }
 354             $path_lookup = $method_path_lookup->{$class};
 355         }
 356     }
 357
 358     return undef if !$path_lookup;
 359
 360     return ($class, $path_lookup);
 361 }
 362
 363 sub find_handler {
 364     my ($class, $method, $path, $uri_param, $pathmatchref) = @_;
 365
 366     my $stack = [ grep { length($_) > 0 }  split('\/+' , $path)]; # skip empty fragments
 367
 368     my ($handler_class, $path_info);
 369     eval {
 370         ($handler_class, $path_info) = $class->map_path_to_methods($stack, $uri_param, $pathmatchref);
 371     };
 372     my $err = $@;
 373     syslog('err', $err) if $err;
 374
 375     return undef if !($handler_class && $path_info);
 376
 377     my $method_info = $path_info->{$method};
 378
 379     return undef if !$method_info;
 380
 381     return ($handler_class, $method_info);
 382 }
 383
 384 sub handle {
 385     my ($self, $info, $param) = @_;
 386
 387     my $func = $info->{code};
 388
 389     if (!($info->{name} && $func)) {
 390         raise("Method lookup failed ('$info->{name}')\n",
 391               code => HTTP_INTERNAL_SERVER_ERROR);
 392     }
 393
 394     if (my $schema = $info->{parameters}) {
 395         # warn "validate ". Dumper($param}) . "\n" . Dumper($schema);
 396         PVE::JSONSchema::validate($param, $schema);
 397         # untaint data (already validated)
 398         my $extra = delete $param->{'extra-args'};
 399         while (my ($key, $val) = each %$param) {
 400             ($param->{$key}) = $val =~ /^(.*)$/s;
 401         }
 402         $param->{'extra-args'} = [map { /^(.*)$/ } @$extra] if $extra;
 403     }
 404
 405     my $result = &$func($param);
 406
 407     # todo: this is only to be safe - disable?
 408     if (my $schema = $info->{returns}) {
 409         PVE::JSONSchema::validate($result, $schema, "Result verification failed\n");
 410     }
 411
 412     return $result;
 413 }
 414
 415 # format option, display type and description
 416 # $name: option name
 417 # $display_name: for example "-$name" of "<$name>", pass undef to use "$name:"
 418 # $phash: json schema property hash
 419 # $format: 'asciidoc', 'short', 'long' or 'full'
 420 # $style: 'config', 'arg' or 'fixed'
 421 my $get_property_description = sub {
 422     my ($name, $style, $phash, $format, $hidepw, $fileparams) = @_;
 423
 424     my $res = '';
 425
 426     $format = 'asciidoc' if !defined($format);
 427
 428     my $descr = $phash->{description} || "no description available";
 429
 430     if ($phash->{verbose_description} &&
 431         ($style eq 'config' || $style eq 'config-sub')) {
 432         $descr = $phash->{verbose_description};
 433     }
 434
 435     chomp $descr;
 436
 437     my $type = PVE::JSONSchema::schema_get_type_text($phash);
 438
 439     if ($hidepw && $name eq 'password') {
 440         $type = '';
 441     }
 442
 443     if ($fileparams && $type eq 'string') {
 444         foreach my $elem (@$fileparams) {
 445             if ($name eq $elem) {
 446                 $type = 'filepath';
 447                 last;
 448             }
 449         }
 450     }
 451
 452     if ($format eq 'asciidoc') {
 453
 454         if ($style eq 'config') {
 455             $res .= "`$name`: ";
 456         } elsif ($style eq 'config-sub') {
 457             $res .= "`$name`=";
 458         } elsif ($style eq 'arg') {
 459             $res .= "`-$name` ";
 460         } elsif ($style eq 'fixed') {
 461             $res .= "`<$name>` ";
 462         } else {
 463             die "unknown style '$style'";
 464         }
 465
 466         $res .= "`$type` " if $type;
 467
 468         if (defined(my $dv = $phash->{default})) {
 469             $res .= "(default=`$dv`)";
 470         }
 471
 472         if ($style eq 'config-sub') {
 473             $res .= ";;\n\n";
 474         } else {
 475             $res .= "::\n\n";
 476         }
 477
 478         my $wdescr = $descr;
 479         chomp $wdescr;
 480         $wdescr =~ s/^$/+/mg;
 481
 482         $res .= $wdescr . "\n";
 483
 484         if (my $req = $phash->{requires}) {
 485             my $tmp .= ref($req) ? join(', ', @$req) : $req;
 486             $res .= "+\nNOTE: Requires option(s): `$tmp`\n";
 487         }
 488         $res .= "\n";
 489
 490     } elsif ($format eq 'short' || $format eq 'long' || $format eq 'full') {
 491
 492         my $defaulttxt = '';
 493         if (defined(my $dv = $phash->{default})) {
 494             $defaulttxt = "   (default=$dv)";
 495         }
 496
 497         my $display_name;
 498         if ($style eq 'config') {
 499             $display_name = "$name:";
 500         } elsif ($style eq 'arg') {
 501             $display_name = "-$name";
 502         } elsif ($style eq 'fixed') {
 503             $display_name = "<$name>";
 504         } else {
 505             die "unknown style '$style'";
 506         }
 507
 508         my $tmp = sprintf "  %-10s %s$defaulttxt\n", $display_name, "$type";
 509         my $indend = "             ";
 510
 511         $res .= Text::Wrap::wrap('', $indend, ($tmp));
 512         $res .= "\n",
 513         $res .= Text::Wrap::wrap($indend, $indend, ($descr)) . "\n\n";
 514
 515         if (my $req = $phash->{requires}) {
 516             my $tmp = "Requires option(s): ";
 517             $tmp .= ref($req) ? join(', ', @$req) : $req;
 518             $res .= Text::Wrap::wrap($indend, $indend, ($tmp)). "\n\n";
 519         }
 520
 521     } else {
 522         die "unknown format '$format'";
 523     }
 524
 525     return $res;
 526 };
 527
 528 # generate usage information for command line tools
 529 #
 530 # $name        ... the name of the method
 531 # $prefix      ... usually something like "$exename $cmd" ('pvesm add')
 532 # $arg_param   ... list of parameters we want to get as ordered arguments
 533 #                  on the command line (or single parameter name for lists)
 534 # $fixed_param ... do not generate and info about those parameters
 535 # $format:
 536 #   'long'     ... default (text, list all options)
 537 #   'short'    ... command line only (text, one line)
 538 #   'full'     ... text, include description
 539 #   'asciidoc' ... generate asciidoc for man pages (like 'full')
 540 # $hidepw      ... hide password option (use this if you provide a read passwork callback)
 541 # $stringfilemap ... mapping for string parameters to file path parameters
 542 sub usage_str {
 543     my ($self, $name, $prefix, $arg_param, $fixed_param, $format, $hidepw, $stringfilemap) = @_;
 544
 545     $format = 'long' if !$format;
 546
 547     my $info = $self->map_method_by_name($name);
 548     my $schema = $info->{parameters};
 549     my $prop = $schema->{properties};
 550
 551     my $out = '';
 552
 553     my $arg_hash = {};
 554
 555     my $args = '';
 556
 557     $arg_param = [ $arg_param ] if $arg_param && !ref($arg_param);
 558
 559     foreach my $p (@$arg_param) {
 560         next if !$prop->{$p}; # just to be sure
 561         my $pd = $prop->{$p};
 562
 563         $arg_hash->{$p} = 1;
 564         $args .= " " if $args;
 565         if ($pd->{format} && $pd->{format} =~ m/-list/) {
 566             $args .= "{<$p>}";
 567         } else {
 568             $args .= $pd->{optional} ? "[<$p>]" : "<$p>";
 569         }
 570     }
 571
 572     my $argdescr = '';
 573     foreach my $k (@$arg_param) {
 574         next if defined($fixed_param->{$k}); # just to be sure
 575         next if !$prop->{$k}; # just to be sure
 576         $argdescr .= &$get_property_description($k, 'fixed', $prop->{$k}, $format, 0);
 577     }
 578
 579     my $idx_param = {}; # -vlan\d+ -scsi\d+
 580
 581     my $opts = '';
 582     foreach my $k (sort keys %$prop) {
 583         next if $arg_hash->{$k};
 584         next if defined($fixed_param->{$k});
 585
 586         my $type = $prop->{$k}->{type} || 'string';
 587
 588         next if $hidepw && ($k eq 'password') && !$prop->{$k}->{optional};
 589
 590         my $base = $k;
 591         if ($k =~ m/^([a-z]+)(\d+)$/) {
 592             my ($name, $idx) = ($1, $2);
 593             next if $idx_param->{$name};
 594             if ($idx == 0 && defined($prop->{"${name}1"})) {
 595                 $idx_param->{$name} = 1;
 596                 $base = "${name}[n]";
 597             }
 598         }
 599
 600         my $mapping = defined($stringfilemap) ? &$stringfilemap($name) : undef;
 601         $opts .= &$get_property_description($base, 'arg', $prop->{$k}, $format,
 602                                             $hidepw, $mapping);
 603
 604         if (!$prop->{$k}->{optional}) {
 605             $args .= " " if $args;
 606             $args .= "-$base <$type>"
 607         }
 608     }
 609
 610     if ($format eq 'asciidoc') {
 611         $out .= "*${prefix}*";
 612         $out .= " `$args`" if $args;
 613         $out .= $opts ? " `[OPTIONS]`\n" : "\n";
 614     } else {
 615         $out .= "USAGE: " if $format ne 'short';
 616         $out .= "$prefix $args";
 617         $out .= $opts ? " [OPTIONS]\n" : "\n";
 618     }
 619
 620     return $out if $format eq 'short';
 621
 622     if ($info->{description}) {
 623         if ($format eq 'asciidoc') {
 624             my $desc = Text::Wrap::wrap('', '', ($info->{description}));
 625             $out .= "\n$desc\n\n";
 626         } elsif ($format eq 'full') {
 627             my $desc = Text::Wrap::wrap('  ', '  ', ($info->{description}));
 628             $out .= "\n$desc\n\n";
 629         }
 630     }
 631
 632     $out .= $argdescr if $argdescr;
 633
 634     $out .= $opts if $opts;
 635
 636     return $out;
 637 }
 638
 639 # generate docs from JSON schema properties
 640 sub dump_properties {
 641     my ($prop, $format, $style, $filterFn) = @_;
 642
 643     my $raw = '';
 644
 645     $style //= 'config';
 646
 647     my $idx_param = {}; # -vlan\d+ -scsi\d+
 648
 649     foreach my $k (sort keys %$prop) {
 650         my $phash = $prop->{$k};
 651
 652         next if defined($filterFn) && &$filterFn($k, $phash);
 653         next if $phash->{alias};
 654
 655         my $base = $k;
 656         if ($k =~ m/^([a-z]+)(\d+)$/) {
 657             my ($name, $idx) = ($1, $2);
 658             next if $idx_param->{$name};
 659             if ($idx == 0 && defined($prop->{"${name}1"})) {
 660                 $idx_param->{$name} = 1;
 661                 $base = "${name}[n]";
 662             }
 663         }
 664
 665         $raw .= &$get_property_description($base, $style, $phash, $format, 0);
 666
 667         next if $style ne 'config';
 668
 669         my $prop_fmt = $phash->{format};
 670         next if !$prop_fmt;
 671
 672         if (ref($prop_fmt) ne 'HASH') {
 673             $prop_fmt = PVE::JSONSchema::get_format($prop_fmt);
 674         }
 675
 676         next if !(ref($prop_fmt) && (ref($prop_fmt) eq 'HASH'));
 677
 678         $raw .= dump_properties($prop_fmt, $format, 'config-sub')
 679
 680     }
 681
 682     return $raw;
 683 }
 684
 685 my $replace_file_names_with_contents = sub {
 686     my ($param, $mapping) = @_;
 687
 688     if ($mapping) {
 689         foreach my $elem ( @$mapping ) {
 690             $param->{$elem} = PVE::Tools::file_get_contents($param->{$elem})
 691                 if defined($param->{$elem});
 692         }
 693     }
 694
 695     return $param;
 696 };
 697
 698 sub cli_handler {
 699     my ($self, $prefix, $name, $args, $arg_param, $fixed_param, $pwcallback, $stringfilemap) = @_;
 700
 701     my $info = $self->map_method_by_name($name);
 702
 703     my $res;
 704     eval {
 705         my $param = PVE::JSONSchema::get_options($info->{parameters}, $args, $arg_param, $fixed_param, $pwcallback);
 706         &$replace_file_names_with_contents($param, &$stringfilemap($name))
 707             if defined($stringfilemap);
 708         $res = $self->handle($info, $param);
 709     };
 710     if (my $err = $@) {
 711         my $ec = ref($err);
 712
 713         die $err if !$ec || $ec ne "PVE::Exception" || !$err->is_param_exc();
 714
 715         $err->{usage} = $self->usage_str($name, $prefix, $arg_param, $fixed_param, 'short', $pwcallback, $stringfilemap);
 716
 717         die $err;
 718     }
 719
 720     return $res;
 721 }
 722
 723 # utility methods
 724 # note: this modifies the original hash by adding the id property
 725 sub hash_to_array {
 726     my ($hash, $idprop) = @_;
 727
 728     my $res = [];
 729     return $res if !$hash;
 730
 731     foreach my $k (keys %$hash) {
 732         $hash->{$k}->{$idprop} = $k;
 733         push @$res, $hash->{$k};
 734     }
 735
 736     return $res;
 737 }
 738
 739 1;