|  line  | 
 stmt  | 
 bran  | 
 cond  | 
 sub  | 
 pod  | 
 time  | 
 code  | 
| 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 package Petal::Utils::Like;  | 
| 
2
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
3
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
25
 | 
 use strict;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
9
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
172
 | 
    | 
| 
4
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
25
 | 
 use warnings::register;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1023
 | 
    | 
| 
5
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
6
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
155
 | 
 use Carp;  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
13
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
313
 | 
    | 
| 
7
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
8
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
27
 | 
 use base qw( Petal::Utils::Base );  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
20
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
408
 | 
    | 
| 
9
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
10
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
25
 | 
 use constant name    => 'like';  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
8
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
259
 | 
    | 
| 
11
 | 
4
 | 
 
 | 
 
 | 
  
4
  
 | 
 
 | 
23
 | 
 use constant aliases => qw();  | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
7
 | 
    | 
| 
 
 | 
4
 | 
 
 | 
 
 | 
 
 | 
 
 | 
1287
 | 
    | 
| 
12
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
13
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $VERSION  = ((require Petal::Utils), $Petal::Utils::VERSION)[1];  | 
| 
14
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];  | 
| 
15
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
16
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 sub process {  | 
| 
17
 | 
1
 | 
 
 | 
 
 | 
  
1
  
 | 
  
0
  
 | 
86
 | 
     my $class = shift;  | 
| 
18
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
2
 | 
     my $hash  = shift;  | 
| 
19
 | 
1
 | 
 
 | 
  
 33
  
 | 
 
 | 
 
 | 
6
 | 
     my $args  = shift || confess( "'like' expects a variable and a regex (got nothing)!" );  | 
| 
20
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
21
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
10
 | 
     my @args = $class->split_first_arg( $args );  | 
| 
22
 | 
1
 | 
 
 | 
  
 33
  
 | 
 
 | 
 
 | 
15
 | 
     $args    = $args[0] || confess( "1st arg to 'like' should be a variable (got nothing)!" );  | 
| 
23
 | 
1
 | 
 
 | 
  
 33
  
 | 
 
 | 
 
 | 
5
 | 
     my $re   = $args[1] || confess( "2nd arg to 'like' should be a regex (got nothing)!" );  | 
| 
24
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
25
 | 
1
 | 
 
 | 
 
 | 
 
 | 
 
 | 
4
 | 
     my $result = $hash->fetch( $args );  | 
| 
26
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
27
 | 
1
 | 
  
 50
  
 | 
 
 | 
 
 | 
 
 | 
75
 | 
     return $result =~ /$re/ ? 1 : 0;  | 
| 
28
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 }  | 
| 
29
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
    | 
| 
30
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 
 | 
 1;  |