view release on metacpan or  search on metacpan

Nobody/Util.pm  view on Meta::CPAN

  return undef unless safe_blessed($self);
  return $self->can($meth);
}

sub mkref {
  return ref($_[0]) ? $_[0] : \$_[0];
}

sub maybeRef($) {
  die "use class, not maybeRef";
  goto \&class;
}

sub flatten(@) {
  return map { &flatten($_) } @_ unless @_ == 1;
  local ($_) = shift;
  return &flatten(@$_) if ref($_) && reftype($_) eq 'ARRAY';
  return &flatten(%$_) if ref($_) && reftype($_) eq 'HASH';
  return $_;
}

# ---------------------------------------------------------------------------
# String / list utilities
# ---------------------------------------------------------------------------

sub pad {
  local (@_) = @_;
  my ($max) = List::Util::max(map { length } @_);
  for (@_) {
    $_ = join("", $_, '.' x ($max - length));
  }
  @_;
}

sub pasteLines(@) {
  for (join("", @_)) {
    s{\\\n?$}{}sm;
  }
  return join("\n", @_) unless wantarray;
  return @_;
}

sub lsort {
  return sort { length($a) <=> length($b) || $a cmp $b } @_;
}

sub lcmp {
  return length($a) <=> length($b) || $a cmp $b;
}

# ---------------------------------------------------------------------------
# Version comparison
# ---------------------------------------------------------------------------

sub vcmp {
  my ($a, $b) = (
    @_ == 2 ? (shift, shift) :
    @_       ? do { warn "Warning: vcmp wants 2 args or none"; (undef, undef) } :
               ($a, $b)
  );
  my @a = split m{(\D+)}, $a;
  my @b = split m{(\D+)}, $b;
  no warnings;
  while (@a and @b and $a[0] eq $b[0]) {
    shift @a;
    shift @b;
  }
  return 0 unless @a or @b;
  return @a <=> @b unless @a and @b;
  return $a[0] <=> $b[0] || $a[0] cmp $b[0];
}

sub vsort {
  return sort { vcmp($a, $b) } @_;
}

# ---------------------------------------------------------------------------
# Date / time
# ---------------------------------------------------------------------------

sub serdate(;$) {
  my $time = @_ ? $_[0] : time;
  return strftime("%Y%m%d-%H%M%S", gmtime($time));
}

# ---------------------------------------------------------------------------
# Process utilities
# ---------------------------------------------------------------------------

sub child_wait {
  my $kid;
  do {
    $kid = waitpid(0, 0);
    warn "$kid returned $?" if $kid > 1 and $?;
  } while ($kid > 1);
}

# ---------------------------------------------------------------------------
# File utilities
# ---------------------------------------------------------------------------

sub file_id {
  die "useless use of file_id in void context" unless defined wantarray;
  local ($_) = shift;
  return undef unless defined;
  $_ = path($_) unless ref($_);
  return undef unless $_->exists;
  $_->stat;
  return sprintf("%016x:%016x", $st_dev, $st_ino);
}

sub uri {
  eval 'require URI';
  die "$@" if "$@";
  return URI->new($_[0]);
}

# ---------------------------------------------------------------------------
# Serial file/directory maker
# ---------------------------------------------------------------------------

sub serial_maker(%) {