client/common.pl

   1 #!/usr/bin/env perl
   2
   3 sub file_get_contents
   4 {
   5         open my $f, '<', $_[0];
   6         local $/ = undef;
   7         my $c = <$f>;
   8         close $f;
   9         return $c;
  10 }
  11
  12 sub file_get_line
  13 {
  14         open my $f, '<', $_[0];
  15         my $c = <$f>;
  16         chomp $c;
  17         close $f;
  18         return $c;
  19 }
  20
  21 sub file_get_int
  22 {
  23         my $path = shift;
  24         my $s = file_get_line $path;
  25         my ($x) = $s =~ /(-?\d+)/;
  26         return $x;
  27 }
  28
  29 sub svlhk_cb_print
  30 {
  31         my $prefix = shift;
  32         my $value = shift;
  33
  34         printf "%s\t%s\n", join('.', @$prefix), $value;
  35 }
  36
  37 sub svlhk_dump
  38 {
  39         my $objref = shift;
  40         my $prefix = shift;
  41         my $cb_ref = shift // \&svlhk_cb_print;
  42
  43         my $type = ref $objref;
  44
  45         if($type eq '')
  46         {
  47                 $cb_ref->($prefix, $objref);
  48         }
  49         elsif($type eq 'SCALAR')
  50         {
  51                 $cb_ref->($prefix, $$objref);
  52         }
  53         elsif($type eq 'ARRAY')
  54         {
  55                 my $idx = 0;
  56                 for my $elem (@$objref)
  57                 {
  58                         svlhk_dump($elem, [@$prefix, $idx], $cb_ref);
  59                         $idx++;
  60                 }
  61         }
  62         elsif($type eq 'HASH')
  63         {
  64                 for my $key (keys %$objref)
  65                 {
  66                         svlhk_dump($objref->{$key}, [@$prefix, $key], $cb_ref);
  67                 }
  68         }
  69         else
  70         {
  71                 $cb_ref->($prefix, $type);
  72
  73                 # here you may handle different class of blassed hashes
  74                 if($type eq 'Linux::FD::Pid')
  75                 {
  76                         $cb_ref->([@$prefix, 'fileno'], $objref->fileno);
  77                 }
  78                 else
  79                 {
  80                         # dump the HASH if it's a blessed HASH
  81                         if(eval { keys %$objref; 1 })
  82                         {
  83                                 svlhk_dump({%$objref}, $prefix, $cb_ref);
  84                         }
  85                 }
  86         }
  87 }
  88
  89 1;