helper.pm 3.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. package helper;
  2. ## Author: Alois Mahdal at vornet cz
  3. # my private development helpers package
  4. # This program is free software: you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation, either version 3 of the License, or
  7. # (at your option) any later version.
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. # You should have received a copy of the GNU General Public License
  13. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. use Carp;
  15. use YAML;
  16. use Data::Dumper;
  17. ###
  18. # `find . -type f` plus a Windows version. And a front-end
  19. our $PLATFORM;
  20. $PLATFORM = (-d "c:\\windows" ? 'windows' : 'unix' );
  21. sub find_files {
  22. my $path = shift;
  23. if ($PLATFORM eq 'windows') {
  24. return &helper::_find_files_windows($path);
  25. } elsif ($PLATFORM eq 'unix') {
  26. return &helper::_find_files_unix($path);
  27. } else {
  28. croak "unsupported platform!";
  29. }
  30. }
  31. sub _find_files_windows {
  32. my $path = shift;
  33. $path =~ s|/|\\|g;
  34. @files = `dir /b /s /a-d $path`;
  35. chomp @files;
  36. return \@files;
  37. }
  38. sub _find_files_unix {
  39. my $path = shift;
  40. @files = `find $path -type f`;
  41. chomp @files;
  42. return \@files;
  43. }
  44. ###
  45. # load fields from my favorite simple CSV-like format
  46. sub load_fields($) {
  47. my $file = shift;
  48. unless ($file) { carp "nothing to load"; return; }
  49. $file =~ m|\.conf$| or carp "conf files should end with '.conf'";
  50. open $fh, "<", $file or croak "cannot open $file: $!";
  51. my @lines;
  52. LINE: while (<$fh>) {
  53. chomp;
  54. next LINE if m|^\s*#|;
  55. next LINE if m|^$|;
  56. s|^\s+||; s|\s+$||;
  57. s|\s*;\s*|;|g;
  58. my @fields = split ';';
  59. next LINE unless @fields;
  60. push @lines, \@fields;
  61. }
  62. close $fh or carp "cannot close $file: $!";
  63. return \@lines;
  64. }
  65. ###
  66. # simple yet effective shufffle
  67. sub fisher_yates_shuffle {
  68. my $array = shift;
  69. my $i;
  70. for ($i = @$array; --$i; ) {
  71. my $j = int rand ($i+1);
  72. next if $i == $j;
  73. @$array[$i,$j] = @$array[$j,$i];
  74. }
  75. }
  76. ###
  77. # dmup anything (by reference)
  78. my $DUMPS = "./dumps";
  79. my $DEFAULT_FORM = "yaml";
  80. sub dmupp($@) { _dmup("perl", @_) }
  81. sub dmupy($@) { _dmup("yaml", @_) }
  82. sub dmup($@) { _dmup($DEFAULT_FORM, @_) }
  83. sub _dmup($$@) {
  84. my $form = shift;
  85. my $name = ( $_[1] ? shift : "" );
  86. mkdir $DUMPS unless -d $DUMPS;
  87. open my $df, ">", "$DUMPS/$name.dmp";
  88. if ($form eq "yaml") {
  89. print $df YAML::Dump(@_);
  90. } elsif ($form eq "perl") {
  91. print $df Dumper(@_);
  92. }
  93. close $df;
  94. }
  95. ###
  96. # is that @ARRAY shuffled?
  97. sub is_shuffled {
  98. my $array = shift;
  99. my $sorted = [ sort @{$array} ];
  100. my ($n, $i) = (0, 0);
  101. foreach (@{$array}) {
  102. $n++ unless ${$array}[$i] eq ${$sorted}[$i];
  103. $i++;
  104. }
  105. return $n;
  106. }
  107. 1;