view release on metacpan or  search on metacpan

lib/Bot/Cobalt/Utils.pm  view on Meta::CPAN

      }
      $first = 0;
    ## So is trailing $ (end):
    } elsif ($last && $ch eq '$') {
      $re .= '$' ;
      last
    }

    ## Escape metas:
    if (grep { $_ eq $ch } qw/ . ( ) | ^ $ @ % { } /) {
      $re .= "\\$ch" ;
      $in_esc = 0;
      next
    }

    ## Handle * ? + wildcards:
    if ($ch eq '*') {
      $re .= $in_esc ? '\*' : '.*' ;
      $in_esc = 0;
      next
    }
    if ($ch eq '?') {
      $re .= $in_esc ? '\?' : '.' ;
      $in_esc = 0;
      next
    }
    if ($ch eq '+') {
      $re .= $in_esc ? '\+' : '\s' ;
      $in_esc = 0;
      next
    }
    if ( $ch eq '[' || $ch eq ']' ) {
      $re .= $in_esc ? "\\$ch" : $ch ;
      $in_esc = 0;
      next
    }

    ## Switch on/off escaping:
    if ($ch eq "\\") {
      if ($in_esc) {
        $re .= "\\\\";
        $in_esc = 0;
      } else { $in_esc = 1; }
      next
    }

    $re .= $ch;
    $in_esc = 0;
  }

  $re
}


## IRC color codes:
sub color ($;$) {
  ## color($format, $str)
  ## implements mirc formatting codes, against my better judgement
  ## if format is unspecified, returns NORMAL

  ## interpolate bold, reset to NORMAL after:
  ## $str = color('bold') . "Text" . color;
  ##  -or-
  ## format specified strings, resetting NORMAL after:
  ## $str = color('bold', "Some text"); # bold text ending in normal

  my ($format, $str) = @_;
  $format = uc($format||'normal');

  my $selected = $COLORS{$format};

  carp "Invalid COLOR $format passed to color()"
    unless $selected;

  return $selected . $str . $COLORS{NORMAL} if $str;
  $selected || $COLORS{NORMAL};
}


## Time/date ops:
sub timestr_to_secs ($) {
  ## turn something like 2h3m30s into seconds
  my ($timestr) = @_;

  unless ($timestr) {
    carp "timestr_to_secs() received a false value";
    return 0
  }

  ## maybe just seconds:
  return $timestr if $timestr =~ /^[0-9]+$/;

  my @chunks = $timestr =~ m/([0-9]+)([dhms])/gc;

  my $secs = 0;
  while ( my ($ti, $unit) = splice @chunks, 0, 2 ) {
    UNIT: {
      if ($unit eq 'd') {
        $secs += $ti * 86400;
        last UNIT
      }

      if ($unit eq 'h') {
        $secs += $ti * 3600;
        last UNIT
      }

      if ($unit eq 'm') {
        $secs += $ti * 60;
        last UNIT
      }

      $secs += $ti;
    }
  }

  $secs
}

sub _time_breakdown ($) {
  my ($diff) = @_;
  return unless defined $diff;

  my $days   = int $diff / 86400;
  my $sec    = $diff % 86400;

lib/Bot/Cobalt/Utils.pm  view on Meta::CPAN

=head2 Date and Time

=head3 timestr_to_secs

Convert a string such as "2h10m" into seconds.

  my $delay_s = timestr_to_secs '1h33m10s';

Useful for dealing with timers.


=head3 secs_to_timestr

Turns seconds back into a timestring suitable for feeding to 
L</timestr_to_secs>:

  my $timestr = secs_to_timestr 820; ## -> 13m40s


=head3 secs_to_str

Convert a timestamp delta into a string.

Useful for uptime reporting, for example:

  my $delta = time() - $your_start_TS;
  my $uptime_str = secs_to_str $delta;

Returns time formatted as: C<< <D> day(s), <H>:<M>:<S> >>

=head3 secs_to_str_y

Like L</secs_to_str>, but includes year calculation and returns time formatted
as: C<< <Y> year(s), <D> day(s), <H>:<M>:<S> >> B<if> there are more than 365
days; otherwise the same format as L</secs_to_str> is returned.

(Added in C<v0.18.1>)

=head2 String Formatting

=head3 color

Add mIRC formatting and color codes to a string.

Valid formatting codes:

  NORMAL BOLD UNDERLINE REVERSE ITALIC

Valid color codes:

  WHITE BLACK BLUE GREEN RED BROWN PURPLE ORANGE YELLOW TEAL PINK
  LIGHT_CYAN LIGHT_BLUE LIGHT_GRAY LIGHT_GREEN

Format/color type can be passed in upper or lower case.

If passed just a color or format name, returns the control code.

If passed nothing at all, returns the 'NORMAL' reset code:

  my $str = color('bold') . "bold text" . color() . "normal text";

If passed a color or format name and a string, returns the formatted
string, terminated by NORMAL:

  my $formatted = color('red', "red text") . "normal text";

If you need to retrieve (or alter via C<local>, for example) the actual
control characters themselves, they are accessible via the C<<
%Bot::Cobalt::Utils::COLORS >> hash:

  my $red = $Bot::Cobalt::Utils::COLORS{RED}

=head3 glob_to_re_str

glob_to_re_str() converts Cobalt-style globs to regex strings.

  my $re = glob_to_re_str "th?ngs*stuff";
  ## or perhaps compile it:
  my $compiled_re = qr/$re/;

Perl regular expressions are very convenient and powerful. Unfortunately, 
that also means it's easy to make them eat up all of your CPU and thereby 
possibly break your system (or at least be annoying!)

For string search functions, it's better to use Cobalt-style globs:

  * == match any number of any character
  ? == match any single character
  + == match any single space
  leading ^  == anchor at start of string
  trailing $ == anchor at end of string

Standard regex syntax will be escaped and a translated regex returned.

The only exception is character classes; this is valid, for example:

  ^[a-z0-9]*$

=head3 glob_to_re

glob_to_re() converts Cobalt-style globs to B<compiled> regexes (qr//)

Using a compiled regex for matching is faster. Note that compiled regexes 
can also be serialized to B<YAML> using Bot::Cobalt::Serializer.

See L</glob_to_re_str> for details on globs. This function shares the same 
syntax.


=head3 glob_grep

glob_grep() can be used to search an array or an array reference for strings 
matching the specified glob:

  my @matches = glob_grep($glob, @array) || 'No matches!';
  my @matches = glob_grep($glob, $array_ref);

Returns the output of grep, which will be a list in list context or 
the number of matches in scalar context.