123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127 |
- 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 <http://www.gnu.org/licenses/>.
-
- 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;
|