relocate repo files so ND2 is the only code

lib/App/Netdisco/Util/Web.pm

@@ -0,0 +1,220 @@
+package App::Netdisco::Util::Web;
+
+use strict;
+use warnings;
+
+use base 'Exporter';
+use Time::Piece;
+use Time::Seconds;
+our @EXPORT = ();
+our @EXPORT_OK = qw/
+  sort_port sort_modules interval_to_daterange sql_match
+/;
+our %EXPORT_TAGS = (all => \@EXPORT_OK);
+
+=head1 NAME
+
+App::Netdisco::Util::Web
+
+=head1 DESCRIPTION
+
+A set of helper subroutines to support parts of the Netdisco application.
+
+There are no default exports, however the C<:all> tag will export all
+subroutines.
+
+=head1 EXPORT_OK
+
+=head2 sql_match( $value, $exact? )
+
+Convert wildcard characters "C<*>" and "C<?>" to "C<%>" and "C<_>"
+respectively.
+
+Pass a true value to C<$exact> to only substitute the existing wildcards, and
+not also add "C<*>" to each end of the value.
+
+In list context, returns two values, the translated value, and also an
+L<SQL::Abstract> LIKE clause.
+
+=cut
+
+sub sql_match {
+  my ($text, $exact) = @_;
+  return unless $text;
+
+  $text =~ s/^\s+//;
+  $text =~ s/\s+$//;
+
+  $text =~ s/[*]+/%/g;
+  $text =~ s/[?]/_/g;
+
+  $text = '%'. $text . '%' unless $exact;
+  $text =~ s/\%+/%/g;
+
+  return ( wantarray ? ($text, {-ilike => $text}) : $text );
+}
+
+=head2 sort_port( $a, $b )
+
+Sort port names of various types used by device vendors. Interface is as
+Perl's own C<sort> - two input args and an integer return value.
+
+=cut
+
+sub sort_port {
+    my ($aval, $bval) = @_;
+
+    # hack for foundry "10GigabitEthernet" -> cisco-like "TenGigabitEthernet"
+    $aval = $1 if $aval =~ qr/^10(GigabitEthernet.+)$/;
+    $bval = $1 if $bval =~ qr/^10(GigabitEthernet.+)$/;
+
+    my $numbers        = qr{^(\d+)$};
+    my $numeric        = qr{^([\d\.]+)$};
+    my $dotted_numeric = qr{^(\d+)[:.](\d+)$};
+    my $letter_number  = qr{^([a-zA-Z]+)(\d+)$};
+    my $wordcharword   = qr{^([^:\/.]+)[-\ :\/\.]+([^:\/.0-9]+)(\d+)?$}; #port-channel45
+    my $netgear        = qr{^Slot: (\d+) Port: (\d+) }; # "Slot: 0 Port: 15 Gigabit - Level"
+    my $ciscofast      = qr{^
+                            # Word Number slash (Gigabit0/)
+                            (\D+)(\d+)[\/:]
+                            # Groups of symbol float (/5.5/5.5/5.5), separated by slash or colon
+                            ([\/:\.\d]+)
+                            # Optional dash (-Bearer Channel)
+                            (-.*)?
+                            $}x;
+
+    my @a = (); my @b = ();
+
+    if ($aval =~ $dotted_numeric) {
+        @a = ($1,$2);
+    } elsif ($aval =~ $letter_number) {
+        @a = ($1,$2);
+    } elsif ($aval =~ $netgear) {
+        @a = ($1,$2);
+    } elsif ($aval =~ $numbers) {
+        @a = ($1);
+    } elsif ($aval =~ $ciscofast) {
+        @a = ($1,$2);
+        push @a, split(/[:\/]/,$3), $4;
+    } elsif ($aval =~ $wordcharword) {
+        @a = ($1,$2,$3);
+    } else {
+        @a = ($aval);
+    }
+
+    if ($bval =~ $dotted_numeric) {
+        @b = ($1,$2);
+    } elsif ($bval =~ $letter_number) {
+        @b = ($1,$2);
+    } elsif ($bval =~ $netgear) {
+        @b = ($1,$2);
+    } elsif ($bval =~ $numbers) {
+        @b = ($1);
+    } elsif ($bval =~ $ciscofast) {
+        @b = ($1,$2);
+        push @b, split(/[:\/]/,$3),$4;
+    } elsif ($bval =~ $wordcharword) {
+        @b = ($1,$2,$3);
+    } else {
+        @b = ($bval);
+    }
+
+    # Equal until proven otherwise
+    my $val = 0;
+    while (scalar(@a) or scalar(@b)){
+        # carried around from the last find.
+        last if $val != 0;
+
+        my $a1 = shift @a;
+        my $b1 = shift @b;
+
+        # A has more components - loses
+        unless (defined $b1){
+            $val = 1;
+            last;
+        }
+
+        # A has less components - wins
+        unless (defined $a1) {
+            $val = -1;
+            last;
+        }
+
+        if ($a1 =~ $numeric and $b1 =~ $numeric){
+            $val = $a1 <=> $b1;
+        } elsif ($a1 ne $b1) {
+            $val = $a1 cmp $b1;
+        }
+    }
+
+    return $val;
+}
+
+=head2 sort_modules( $modules )
+
+Sort devices modules into tree hierarchy based upon position and parent -
+input arg is module list.
+
+=cut
+
+sub sort_modules {
+    my $input = shift;
+    my %modules;
+
+    foreach my $module (@$input) {
+        $modules{$module->index}{module} = $module;
+        if ($module->parent) {
+            # Example
+            # index |              description               |        type         | parent |  class  | pos 
+            #-------+----------------------------------------+---------------------+--------+---------+-----
+            #     1 | Cisco Aironet 1200 Series Access Point | cevChassisAIRAP1210 |      0 | chassis |  -1
+            #     3 | PowerPC405GP Ethernet                  | cevPortFEIP         |      1 | port    |  -1
+            #     2 | 802.11G Radio                          | cevPortUnknown      |      1 | port    |   0
+
+            # Some devices do not implement correctly, so given parent
+            # can have multiple items within the same class at a single pos
+            # value.  However, the database results are sorted by 1) parent
+            # 2) class 3) pos 4) index so we should just be able to push onto
+            # the array and ordering be preserved.
+            {
+              no warnings 'uninitialized';
+              push(@{$modules{$module->parent}{children}{$module->class}}, $module->index);
+            }
+        } else {
+            push(@{$modules{root}}, $module->index);
+        }
+    }
+    return \%modules;
+}
+
+=head2 interval_to_daterange( $interval )
+
+Takes an interval in days, weeks, months, or years in a format like '7 days'
+and returns a date range in the format 'YYYY-MM-DD to YYYY-MM-DD' by
+subtracting the interval from the current date.
+
+=cut
+
+sub interval_to_daterange {
+    my $interval = shift;
+
+    return unless $interval =~ m/^(?:\d+)\s+(?:day|week|month|year)s?$/;
+
+    my %const = (
+        day   => ONE_DAY,
+        week  => ONE_WEEK,
+        month => ONE_MONTH,
+        year  => ONE_YEAR
+    );
+
+    my ( $amt, $factor )
+        = $interval =~ /^(\d+)\s+(day|week|month|year)s?$/gmx;
+
+    $amt-- if $factor eq 'day';
+
+    my $start = Time::Piece->new - $const{$factor} * $amt;
+
+    return $start->ymd . " to " . Time::Piece->new->ymd;
+}
+
+1;