File Coverage

blib/lib/Metabrik/Binjitsu/Pattern.pm
Criterion Covered Total %
statement 9 55 16.3
branch 0 16 0.0
condition 0 2 0.0
subroutine 3 6 50.0
pod 1 3 33.3
total 13 82 15.8


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # binjitsu::pattern Brik
5             #
6             package Metabrik::Binjitsu::Pattern;
7 1     1   750 use strict;
  1         2  
  1         31  
8 1     1   6 use warnings;
  1         2  
  1         35  
9              
10 1     1   6 use base qw(Metabrik);
  1         2  
  1         777  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'ZadYree ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             output => [ qw(file) ],
21             max_size => [ qw(size) ],
22             },
23             attributes_default => {
24             max_size => 65535,
25             },
26             commands => {
27             create => [ qw(size file|OPTIONAL) ],
28             offset => [ qw(point) ],
29             },
30             require_modules => {
31             'Metabrik::String::Hexa' => [ ],
32             'Path::Tiny' => [ ],
33             },
34             };
35             }
36              
37             sub create {
38 0     0 0   my $self = shift;
39 0   0       my $count = int(shift) || 16;
40              
41 0           my ($flw);
42 0 0         if ( $self->output ) {
43 0           $flw = Path::Tiny->new( $self->datadir )->child( $self->output );
44             }
45              
46 0 0         $self->log->error("create: Too large pattern :("), die
47             unless $count < $self->max_size;
48 0           my $set = {
49             ALPHA_LOWER => [ "a" .. "z" ],
50             ALPHA_UPPER => [ "A" .. "Z" ],
51             NUMS => [ 0 .. 9 ],
52             };
53              
54 0           my $patt = "";
55 0           for my $chr0 ( @{ $set->{ALPHA_UPPER} } ) {
  0            
56 0 0         last unless ( length($patt) < $count );
57 0           for my $chr1 ( @{ $set->{ALPHA_UPPER} } ) {
  0            
58 0           for my $chr2 ( @{ $set->{NUMS} } ) {
  0            
59 0           for my $chr3 ( @{ $set->{ALPHA_LOWER} } ) {
  0            
60 0           $patt .= $chr0 . $chr1 . $chr2 . $chr3;
61             }
62             }
63             }
64             }
65              
66 0           $patt = substr( $patt, 0, $count );
67 0 0         if ($flw) {
68 0           $self->log->info( "create: Writing pattern to " . $flw->stringify );
69 0           $flw->spew($patt);
70 0           return 1;
71             }
72              
73 0           return \$patt;
74             }
75              
76             sub offset {
77 0     0 0   my $self = shift;
78 0           my $point = shift;
79              
80 0 0         $self->brik_help_run_undef_arg( 'offset', $point ) or return;
81              
82 0           $self->log->verbose(
83             "offset: Finding offset for $point. /!\\ This is experimental (really!) /!\\");
84              
85 0           $point =~ s/0x//;
86              
87 0           my ($idx);
88             my ($chrs);
89 0 0         if ( length($point) == 8 ) {
    0          
90 0           $chrs = [ split( /(..)/, substr( $point, 0, 8 ) ) ];
91 0           $chrs = pack( 'V', hex( join( '', @$chrs ) ) );
92              
93 0           $idx = index( ${ $self->create( $self->max_size - 1 ) }, $chrs );
  0            
94             }
95             elsif ( length($point) == 16 ) {
96 0           $chrs = [ split( /(..)/, substr( $point, 0, 16 ) ) ];
97 0           $chrs = pack( 'L!', hex( join( '', @$chrs ) ) );
98              
99 0           $idx = index( ${ $self->create( $self->max_size - 1 ) }, $chrs );
  0            
100             }
101 0           else { $self->log->error("offset: Bad address size."); return; }
  0            
102              
103 0 0         if ( $idx != -1 ) {
104             return {
105 0           pattern => $chrs,
106             position => $idx,
107             };
108             }
109             else {
110 0           $self->log->error("offset: Couldn't find typed offset pattern [ $point ]");
111 0           return;
112             }
113             }
114              
115             1;
116              
117             __END__