knx-groupfinder/filter.pl

#!/usr/bin/perl

package GA;

use strict; use warnings; use Carp;

sub new {
  my $class = shift;
  my $self = { @_ };
  croak "bad GA arguments" unless defined $self->{top} and defined $self->{middle} and defined $self->{bottom};
  return bless $self, $class;
}

sub fromstr {
  my ($class, $str) = @_;
  croak "no string provided" unless defined $str;
  $str =~ /([0-9]+)\/([0-9]+)\/([0-9]+)/;
  my $top = $1;
  my $middle = $2;
  my $bottom = $3;
  return new($class, top => $top, middle => $middle, bottom => $bottom);
}

sub str {
  my $self = shift;
  return "$self->{top}/$self->{middle}/$self->{bottom}";
}

sub comp{
  my ($class, $a, $b) = @_;
  if ($a->{top} < $b->{top}) {
    return -1;
  } elsif ($a->{top} == $b->{top}) {
    if ($a->{middle} < $b->{middle}) {
      return -1;
    }
    elsif($a->{middle} == $b->{middle}) {
      return $a->{bottom} <=> $b->{bottom};
    }
  }
  return 1;
}

package main;

use strict; use warnings;
use Getopt::Long;

my $newlines = '';
my $file = '';
my $ranges = '';
GetOptions ("newlines" => \$newlines, # print newlines
            "file=s" => \$file, # input file
            "ranges" => \$ranges # print with ranges
) or die("Error in command line arguments\n");

my %seen = (); 

my $in_file;

if ($file) {
  open my $in_file, $file or die "Could not open $file: $!";
  while (my $line = <$in_file>) {
    last if not defined $line;
    chomp $line;
    my @l = $line =~ /([0-9]+\/[0-9]+\/[0-9]+)/mg;
    foreach my $item (@l) {
      $seen{$item}++;
    }
  }
  close $in_file;
} else {
  for (;;) {
    my $input = <STDIN>;
    last if not defined $input;
    chomp $input;
    my @l = $input =~ /([0-9]+\/[0-9]+\/[0-9]+)/mg;
    foreach my $item (@l) {
      $seen{$item}++;
    }
  }
}

my @uniq;

foreach my $item (keys %seen) {
  push @uniq, GA->fromstr($item); 
}

@uniq = sort { GA->comp($a, $b) } @uniq;

if ($newlines) {
  if ($ranges) {
    while (my $item = shift @uniq) {
      my $from = $item;
      my $to = $item;

      my @copy = @uniq;
      foreach my $next (@copy) {
        if ($next->{top} == $to->{top} and $next->{middle} == $to->{middle}) {
          if ($next->{bottom} == ($to->{bottom} + 1)) {
            $to = $next;
            shift @uniq;
          }
        }
      }

      if ($from != $to) {
        print "$from->{top}/$from->{middle}/[$from->{bottom}-$to->{bottom}]\n"; 
      } else {
        print $from->str, "\n";
      }
    }
  } else {
    foreach my $item (@uniq) {
      print $item->str, "\n";
    }
  }
} else {
  if ($ranges) {
    print "ranges not implemented for non-nl output\n";
  }
  foreach my $item (@uniq) {
    print $item->str, " ";
  }
  if (@uniq) {
    print "\n";
  }
}