package helper; ## Author: Alois Mahdal at vornet cz # my private development helpers package # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program. If not, see . use Carp; use YAML; use Data::Dumper; ### # `find . -type f` plus a Windows version. And a front-end our $PLATFORM; $PLATFORM = (-d "c:\\windows" ? 'windows' : 'unix' ); sub find_files { my $path = shift; if ($PLATFORM eq 'windows') { return &helper::_find_files_windows($path); } elsif ($PLATFORM eq 'unix') { return &helper::_find_files_unix($path); } else { croak "unsupported platform!"; } } sub _find_files_windows { my $path = shift; $path =~ s|/|\\|g; @files = `dir /b /s /a-d $path`; chomp @files; return \@files; } sub _find_files_unix { my $path = shift; @files = `find $path -type f`; chomp @files; return \@files; } ### # load fields from my favorite simple CSV-like format sub load_fields($) { my $file = shift; unless ($file) { carp "nothing to load"; return; } $file =~ m|\.conf$| or carp "conf files should end with '.conf'"; open $fh, "<", $file or croak "cannot open $file: $!"; my @lines; LINE: while (<$fh>) { chomp; next LINE if m|^\s*#|; next LINE if m|^$|; s|^\s+||; s|\s+$||; s|\s*;\s*|;|g; my @fields = split ';'; next LINE unless @fields; push @lines, \@fields; } close $fh or carp "cannot close $file: $!"; return \@lines; } ### # simple yet effective shufffle sub fisher_yates_shuffle { my $array = shift; my $i; for ($i = @$array; --$i; ) { my $j = int rand ($i+1); next if $i == $j; @$array[$i,$j] = @$array[$j,$i]; } } ### # dmup anything (by reference) my $DUMPS = "./dumps"; my $DEFAULT_FORM = "yaml"; sub dmupp($@) { _dmup("perl", @_) } sub dmupy($@) { _dmup("yaml", @_) } sub dmup($@) { _dmup($DEFAULT_FORM, @_) } sub _dmup($$@) { my $form = shift; my $name = ( $_[1] ? shift : "" ); mkdir $DUMPS unless -d $DUMPS; open my $df, ">", "$DUMPS/$name.dmp"; if ($form eq "yaml") { print $df YAML::Dump(@_); } elsif ($form eq "perl") { print $df Dumper(@_); } close $df; } ### # is that @ARRAY shuffled? sub is_shuffled { my $array = shift; my $sorted = [ sort @{$array} ]; my ($n, $i) = (0, 0); foreach (@{$array}) { $n++ unless ${$array}[$i] eq ${$sorted}[$i]; $i++; } return $n; } 1;