Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Print lines based on matching words

by ArifS (Beadle)
on Dec 22, 2014 at 17:41 UTC ( [id://1111054]=perlquestion: print w/replies, xml ) Need Help??

ArifS has asked for the wisdom of the Perl Monks concerning the following question:

Print lines based on matching words. This is what I have so far. 
while (<DATA>) {
/object-group\s/;
# print the next word followed by object-group
my @after=split(/\s/,$');
my @array = $after[0];

# unique array NOT working......
my @unique = do { my %seen; grep { !$seen{$_}++ } @array };

    foreach my $var ( @unique ) {
         # remove word - network
         if ($var !~ m/network/) {
         # remove word - service
         next if ($var =~ m/service/);
              print $var, "\n";
         }
    }
}

__DATA__
access-list INSIDE_IN remark Web Users To Web Server
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

[download]
I am trying to print the lines that matches with given strings.
For example: 
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP<br>

[download]
-will take WEB-CLIENT, WEB-SERVER, WEB_TCP, etc. and under those PC1_1st & PC2_1st etc., to match and then print as following-

Ignore the Line with word - remark.

access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

[download]
For the 2nd matching--- 
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

[download]
Please let me know.

Replies are listed 'Best First'.
Re: Print lines based on matching words
by GrandFather (Saint) on Dec 22, 2014 at 22:20 UTC

    Your description of the problem makes almost no sense at all and your code makes even less sense. However, maybe what you want is to skip lines containing the word "remark"? If so then:

    #!/usr/bin/perl
use strict;
use warnings;

# print the next word followed by object-group
while (<DATA>) {
    print if ! /\bremark\b/;
}

    [download]

    should get you started. However, that doesn't jell with the output you are looking for so maybe the access-list lines are key lines containing key words used to extract blocks of data. So lets play with that idea:

    #!/usr/bin/perl
use strict;
use warnings;
use 5.010;

my @lists;
my %group;
my $lastGroup;

while (defined(my $line = <DATA>)) {
    next if $line =~ /^access-list .*\bremark\b/;

    given ($line) {
        when (/^access-list/) {
            my @keys = $line =~ /([A-Z]+[-_][A-Z]+)/g;
            push @lists, {groups => \@keys, line => $line};
        }
        when (/object-group\s+(\S+)\s+(\S+)/) {
            $group{$2}{line} = $line;
            $group{$2}{data} = [];
            $lastGroup       = $2;
        }
        default {
            push @{$group{$lastGroup}{data}},   $line;
            push @{$group{$lastGroup}{groups}}, $1
                if $line =~ /^\s+\S+\s+(\S+)$/;
        }
    }
}

for my $list (@lists) {
    print $list->{line};
    printGroups($list->{groups}, %group);
    print "\n";
}


sub printGroups {
    my ($groups, %groupData) = @_;

    for my $group (sort @$groups) {
        next if !exists $groupData{$group};

        print $groupData{$group}{line};
        print @{$groupData{$group}{data}} if $groupData{$group}{data};
        printGroups($groupData{$group}{groups}, %groupData)
            if exists $groupData{$group}{groups};
    }
}

__DATA__
access-list INSIDE_IN remark Web Users To Web Server
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

    [download]

    prints:

    access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

    [download]

    which looks pretty much like your required output.

    Perl is the programming world's equivalent of English
[reply]
[d/l]
[select]
      oops never mind. I had to add in the following-
      /([A-Z\d]+[-_][A-Z\d]+)/ig;

      Working as expected. Thanks again!
[reply]
[d/l]
      That's exactly what I was looking for. Thank you very much!
[reply]
      I tried the script with the following for something different & seems like it's not giving the desired output- 
      __DATA__
access-list INSIDE_IN remark Web Users To Web Server
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
access-list INSIDE_IN remark SRVR to Client
access-list INSIDE_IN extended permit tcp object-group MYSRVR_2nd obje
+ct-group MYCLIENTS_1st object-group WEB_TCP

object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

object-group network MYCLIENTS_1st
 network-object host 10.1.2.1
 network-object host 10.1.2.2
 network-object host 10.1.2.3
 network-object host 10.1.2.4
object-group network MYSRVR_2nd
 network-object host 10.1.1.4
 network-object host 10.1.1.3
 network-object host 10.1.1.31
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

      [download]
      PRINTS: 
      access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
print "\n";
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP
access-list INSIDE_IN extended permit tcp object-group MYSRVR_2nd obje
+ct-group MYCLIENTS_1st object-group WEB_TCP
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
print "\n";

      [download]
      INSTEAD OF- 
      access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

access-list INSIDE_IN extended permit tcp object-group MYSRVR_2nd obje
+ct-group MYCLIENTS_1st object-group WEB_TCP
object-group network MYSRVR_2nd
 network-object host 10.1.1.4
 network-object host 10.1.1.3
 network-object host 10.1.1.31
object-group network MYCLIENTS_1st
 network-object host 10.1.2.1
 network-object host 10.1.2.2
 network-object host 10.1.2.3
 network-object host 10.1.2.4
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

      [download]
      Please let me know.
[reply]
[d/l]
[select]
      From the script above - 
      my @keys = $line =~ /([A-Z\d]+[-_][A-Z\d]+)/ig;

      [download]
      Seems to match - WEB-CLIENT, SMTP_TCP etc.
      But, how can I also match - MYCLIENTS-IP_1st, MYSRVR_IP-S_2nd etc. 
      __DATA__
access-list INSIDE_IN remark Web Users To Web Server
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
access-list INSIDE_IN remark SRVR to Client
access-list INSIDE_IN extended permit tcp object-group MYSRVR_IP-S_2nd
+ object-group MYCLIENTS-IP_1st object-group WEB_TCP

object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

object-group network MYCLIENTS-IP_1st
 network-object host 10.1.2.1
 network-object host 10.1.2.2
 network-object host 10.1.2.3
 network-object host 10.1.2.4
object-group network MYSRVR_IP-S_2nd
 network-object host 10.1.1.4
 network-object host 10.1.1.3
 network-object host 10.1.1.31
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https

      [download]
      Please let me know.
[reply]
[d/l]
[select]

        Here's a way to match/extract ordinal substrings. Note this won't match an improper ordinal like '1th' or '4rd'. (Update: It's also case-sensitive.) Tested on Windows 7 under ActiveState 5.8.9 and Strawberry 5.14.4.

        Read more... (2 kB)
[reply]
[d/l]
[select]
      I am trying to skip a Section if it already Exists (above). However, the following script add a new line "Exists", but doesn't skip the Section. 
      use strict;
use warnings;
use 5.010;

my @lists;
my %group;
my $lastGroup;

while (defined(my $line = <DATA>)) {
    next if $line =~ /^access-list .*\bremark\b/;

    given ($line) {
        when (/^access-list/) {
            my @keys = $line =~ /([A-Z]+[-_][A-Z]+)/g;
            push @lists, {groups => \@keys, line => $line};
        }
        when (/object-group\s+(\S+)\s+(\S+)/) {
            $group{$2}{line} = $line;
            $group{$2}{data} = [];
            $lastGroup       = $2;
        }
        default {
            push @{$group{$lastGroup}{data}},   $line;
            push @{$group{$lastGroup}{groups}}, $1
                if $line =~ /^\s+\S+\s+(\S+)$/;
        }
    }
}

for my $list (@lists) {
    print $list->{line};
    printGroups($list->{groups}, %group);
    print "\n";
}


sub printGroups {
    my ($groups, %groupData) = @_;

    for my $group (sort @$groups) {

         ############ Skip if Exists above #####
         print "Exists above\n"    if exists $groupData{$group};
         ############ end Skip            #####

        next if !exists $groupData{$group};

        print $groupData{$group}{line};
        print @{$groupData{$group}{data}} if $groupData{$group}{data};
        printGroups($groupData{$group}{groups}, %groupData)
            if Existss $groupData{$group}{groups};
    }
}

__DATA__
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
access-list INSIDE_IN extended permit udp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_UDP
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP
 object-group service SMTP_UDP udp
 port-object eq SMTP

      [download]
      Current OUTPUT 
      access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
Exists above
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
Exists above
object-group network PC1_1st
 network-object host 10.1.1.11
Exists above
object-group network PC2_1st
 network-object host 10.1.1.12
Exists above
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
Exists above
object-group service SMTP_TCP tcp
 port-object eq SMTP
access-list INSIDE_IN extended permit udp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_UDP
Exists above
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
Exists above
object-group network PC1_1st
 network-object host 10.1.1.11
Exists above
object-group network PC2_1st
 network-object host 10.1.1.12
Exists above
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
Exists above
 object-group service SMTP_UDP udp
 port-object eq SMTP

      [download]
      OUTPUT needed 
      access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP
access-list INSIDE_IN extended permit udp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_UDP
Exists above
Exists above
Exists above
Exists above
object-group service SMTP_UDP udp
 port-object eq SMTP

      [download]
      Please let me know.
[reply]
[d/l]
[select]
      GrandFather, Your script is working just fine. I however am trying to take out the duplicate lines if exists above. I tried as following but giving me a hash error-
      Original- 
      for my $list (@lists) {
    print $list->{line};
    printGroups($list->{groups}, %group);
    print "\n";
}

      [download]
      with 
      sub uniq {
    my %seen;
    grep !$seen{$_}++, @_;
}

for my $list (@lists) {
    my @filtered = uniq(@lists);
    printGroups(@filtered->{groups}, %group);

    # prints acl lines AFTER object-groups
    print $list->{line};
    print  "line 54: ACL line\n\n";
}

      [download]
      Please let me know.
[reply]
[d/l]
[select]

        Add a minimum number of lines of code to initialize @lines with data built into the test code and ask again. I have no way of telling what the contents of @lines is, but it seems most likely it is an array of hash refs.

        Premature optimization is the root of all job security
[reply]
Re: Print lines based on matching words
by james28909 (Deacon) on Dec 22, 2014 at 21:54 UTC
    Honestly i am not completely sure on what you want.

    "Print lines based on matching words."
    If you want to print lines based on matching and/or non matching words: 
    while (<DATA>) {
print if ($_ =~ /access-list/i && $_ !~ /remark/i);
}

__DATA__
access-list INSIDE_IN remark Web Users To Web Server
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB_TCP
access-list INSIDE_IN remark EMAIL To EMAIL Server
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group SMTP_TCP
object-group network PC1_1st
 network-object host 10.1.1.11
object-group network PC2_1st
 network-object host 10.1.1.12
object-group network WEB-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network WEB-SERVER
 network-object host 10.1.1.5
object-group service WEB_TCP tcp
 port-object eq www
 port-object eq https
object-group network EMAIL-CLIENT
 group-object PC1_1st
 group-object PC2_1st
object-group network EMAIL-SERVER
 network-object host 10.1.1.6
object-group service SMTP_TCP tcp
 port-object eq SMTP

    [download]
    output:

C:\Users\user\Desktop>test.pl
access-list INSIDE_IN extended permit tcp object-group WEB-CLIENT obje
+ct-group WEB-SERVER object-group WEB
_TCP
access-list INSIDE_IN extended permit tcp object-group EMAIL-CLIENT ob
+ject-group EMAIL-SERVER object-group
 SMTP_TCP

    [download]
    But like i said, i am still =unsure what you are trying to do :(
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: perlquestion [id://1111054]
Approved by Lotus1
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others scrutinizing the Monastery: (3)
As of 2024-04-23 23:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found