浏览代码

Added SugarTrail::CondBlock

Alois Mahdal (@azzgoat) 12 年前
父节点
当前提交
52f252c9d6
共有 2 个文件被更改,包括 63 次插入0 次删除
  1. 47
    0
      lib/SugarTrail/CondBlock.pm
  2. 16
    0
      t/Cond.t

+ 47
- 0
lib/SugarTrail/CondBlock.pm 查看文件

@@ -0,0 +1,47 @@
1
+package SugarTrail::CondBlock;
2
+# condition block
3
+# init()
4
+# parse(string)
5
+# matches(data)
6
+
7
+use strict;
8
+use warnings;
9
+
10
+use Data::Dumper;
11
+
12
+sub init {
13
+    my $class = shift;
14
+    my $self = {};
15
+    return bless $self, $class;
16
+}
17
+
18
+sub parse {
19
+    my $self    = shift;
20
+    my $string  = shift;
21
+
22
+    my @parts = split ";", $string;
23
+
24
+    foreach (@parts) {
25
+        s/^\s+//;
26
+        s/\s+$//;
27
+        my ($n, $o, $v) = m/([a-zA-Z0-9_ ]+)([<>=~+\-*@]*)(.*)/;
28
+        next unless $n;
29
+
30
+        $n =~ s/\s+$//;
31
+        $o =~ s/\s+$//;
32
+        $o =~ s/^\s+//;
33
+        $v =~ s/\s+$//;
34
+
35
+        my @v = split m/\s*,\s*/, $v;
36
+        push @{$self->{conds}}, { n => $n, o => $o, v => \@v };
37
+    }
38
+}
39
+
40
+
41
+
42
+sub match {
43
+    my $self = shift;
44
+    my $args = shift;
45
+}
46
+
47
+1;

+ 16
- 0
t/Cond.t 查看文件

@@ -0,0 +1,16 @@
1
+use Test::More;
2
+
3
+use lib 'lib';
4
+use helper;
5
+
6
+BEGIN { use_ok( 'SugarTrail::CondBlock' ); }
7
+require_ok( 'SugarTrail::CondBlock' );
8
+
9
+my $cb = SugarTrail::CondBlock->init();
10
+ok($cb, "cb is true");
11
+
12
+$cb->parse('os=@w7a,wxx;proto==imap;ver>=2012;');
13
+&helper::dmupp(cb=>$cb);
14
+
15
+
16
+done_testing();