[Bps-public-commit] rt-extension-assetsql branch, master, updated. c22763d77c075eb4a1a63b10846fb68719d9929b

Shawn Moore shawn at bestpractical.com
Thu Jun 16 17:25:59 EDT 2016


The branch, master has been updated
       via  c22763d77c075eb4a1a63b10846fb68719d9929b (commit)
       via  8c6399d6b315bf30ea9fbeec76aae4a27602319a (commit)
      from  26d5c636dea9164923f393c779ab6e4e29e83ee7 (commit)

Summary of changes:
 .gitignore                              |   1 +
 META.yml                                |   2 +-
 Makefile.PL                             |  13 +++
 inc/Module/Install/Substitute.pm        | 131 ++++++++++++++++++++++
 xt/basics.t                             | 192 ++++++++++++++++++++++++++++++++
 xt/compile.t                            |  10 ++
 xt/lib/RT/Extension/AssetSQL/Test.pm.in |  29 +++++
 7 files changed, 377 insertions(+), 1 deletion(-)
 create mode 100644 inc/Module/Install/Substitute.pm
 create mode 100644 xt/basics.t
 create mode 100644 xt/compile.t
 create mode 100644 xt/lib/RT/Extension/AssetSQL/Test.pm.in

- Log -----------------------------------------------------------------
commit 8c6399d6b315bf30ea9fbeec76aae4a27602319a
Author: Shawn M Moore <shawn at bestpractical.com>
Date:   Thu Jun 16 19:43:37 2016 +0000

    Test scaffolding

diff --git a/.gitignore b/.gitignore
index 49b97af..67e46b2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,4 @@ pod2htm*.tmp
 /MYMETA.*
 /t/tmp
 /xt/tmp
+/xt/lib/RT/Extension/AssetSQL/Test.pm
diff --git a/META.yml b/META.yml
index 9a2fd9b..48a35ad 100644
--- a/META.yml
+++ b/META.yml
@@ -16,10 +16,10 @@ meta-spec:
 name: RT-Extension-AssetSQL
 no_index:
   directory:
-    - etc
     - html
     - inc
     - static
+    - xt
   package:
     - RT::Assets
 requires:
diff --git a/Makefile.PL b/Makefile.PL
index af713b1..245f11f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -9,4 +9,17 @@ rt_too_new '4.6';
 
 perl_version '5.010001';
 
+my ($loaded) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $loaded );
+
+substitute(
+    {
+        RT_LIB_PATH  => $lib_path,
+    },
+    {
+        sufix => '.in'
+    },
+    q(xt/lib/RT/Extension/AssetSQL/Test.pm),
+);
+
 WriteAll;
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..56af7fe
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+	my $self = shift;
+	$self->{__subst} = shift;
+	$self->{__option} = {};
+	if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+		my $opts = shift;
+		while( my ($k,$v) = each( %$opts ) ) {
+			$self->{__option}->{ lc( $k ) } = $v || '';
+		}
+	}
+	$self->_parse_options;
+
+	my @file = @_;
+	foreach my $f (@file) {
+		$self->_rewrite_file( $f );
+	}
+
+	return;
+}
+
+sub _parse_options
+{
+	my $self = shift;
+	my $cwd = Cwd::getcwd();
+	foreach my $t ( qw(from to) ) {
+        $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+		my $d = $self->{__option}->{$t};
+		die "Couldn't read directory '$d'" unless -d $d && -r _;
+	}
+}
+
+sub _rewrite_file
+{
+	my ($self, $file) = @_;
+	my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+	$source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+	unless( -f $source && -r _ ) {
+		print STDERR "Couldn't find file '$source'\n";
+		return;
+	}
+	my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+	return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+	my ($self, $source, $dest) = @_;
+
+	my $mode = (stat($source))[2];
+
+	open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+	print "Open input '$source' file for substitution\n";
+
+	my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+	$self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+	close $sfh;
+
+	seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+	open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+	print "Open output '$dest' file for substitution\n";
+
+	while( <$tmpfh> ) {
+		print $dfh $_;
+	}
+	close $dfh;
+	chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+	my ($self, $in, $out, $replace) = @_;
+	
+	my @queue = ();
+	my $subst = $self->{'__subst'};
+	my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+	while( my $str = <$in> ) {
+		if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+			my ($action, $nstr) = ($1,$2);
+			$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+			die "Replace action is bad idea for situations when dest is equal to source"
+                if $replace && $action eq 'replace';
+			if( $action eq 'before' ) {
+				die "no line before 'before' action" unless @queue;
+				# overwrite prev line;
+				pop @queue;
+				push @queue, $nstr;
+				push @queue, $str;
+			} elsif( $action eq 'replace' ) {
+				push @queue, $nstr;
+			} elsif( $action eq 'after' ) {
+				push @queue, $str;
+				push @queue, $nstr;
+				# skip one line;
+				<$in>;
+			}
+		} else {
+			push @queue, $str;
+		}
+		while( @queue > 3 ) {
+			print $out shift(@queue);
+		}
+	}
+	while( scalar @queue ) {
+		print $out shift(@queue);
+	}
+}
+
+1;
+
diff --git a/xt/compile.t b/xt/compile.t
new file mode 100644
index 0000000..9459d16
--- /dev/null
+++ b/xt/compile.t
@@ -0,0 +1,10 @@
+use strict;
+use warnings;
+
+use Test::More;
+use lib 'xt/lib';
+
+use_ok('RT::Extension::AssetSQL::Test');
+use_ok('RT::Extension::AssetSQL');
+use_ok('RT::Extension::AssetSQL::Assets');
+
diff --git a/xt/lib/RT/Extension/AssetSQL/Test.pm.in b/xt/lib/RT/Extension/AssetSQL/Test.pm.in
new file mode 100644
index 0000000..8fed569
--- /dev/null
+++ b/xt/lib/RT/Extension/AssetSQL/Test.pm.in
@@ -0,0 +1,29 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
+
+package RT::Extension::AssetSQL::Test;
+use base 'RT::Test::Assets';
+
+our @EXPORT = @RT::Test::Assets::EXPORT;
+
+sub import {
+    my $class = shift;
+    my %args  = @_;
+
+    $args{'requires'} ||= [];
+    if ( $args{'testing'} ) {
+        unshift @{ $args{'requires'} }, 'RT::Extension::AssetSQL';
+    } else {
+        $args{'testing'} = 'RT::Extension::AssetSQL';
+    }
+
+    $class->SUPER::import( %args );
+
+    require RT::Extension::AssetSQL;
+    __PACKAGE__->export_to_level(1);
+}
+
+1;

commit c22763d77c075eb4a1a63b10846fb68719d9929b
Author: Shawn M Moore <shawn at bestpractical.com>
Date:   Thu Jun 16 21:28:13 2016 +0000

    Basic SQL tests

diff --git a/xt/basics.t b/xt/basics.t
new file mode 100644
index 0000000..3068d23
--- /dev/null
+++ b/xt/basics.t
@@ -0,0 +1,192 @@
+use strict;
+use warnings;
+
+use lib 'xt/lib';
+use RT::Extension::AssetSQL::Test;
+
+my $laptops = create_catalog(Name => 'Laptops');
+my $servers = create_catalog(Name => 'Servers');
+my $keyboards = create_catalog(Name => 'Keyboards');
+
+my $manufacturer = create_cf(Name => 'Manufacturer');
+apply_cfs($manufacturer);
+
+my $blank = create_cf(Name => 'Blank');
+apply_cfs($blank);
+
+my $shawn = RT::User->new(RT->SystemUser);
+my ($ok, $msg) = $shawn->Create(Name => 'shawn', EmailAddress => 'shawn at bestpractical.com');
+ok($ok, $msg);
+
+my $bloc = create_asset(
+    Name                       => 'bloc',
+    Description                => "Shawn's BPS office media server",
+    Catalog                    => 'Servers',
+    Owner                      => $shawn->PrincipalId,
+    Contact                    => $shawn->PrincipalId,
+    'CustomField-Manufacturer' => 'Raspberry Pi',
+);
+my $deleted = create_asset(
+    Name                       => 'deleted',
+    Description                => "for making sure we don't search deleted",
+    Catalog                    => 'Servers',
+);
+my $ecaz = create_asset(
+    Name                       => 'ecaz',
+    Description                => "Shawn's BPS laptop",
+    Catalog                    => 'Laptops',
+    Owner                      => $shawn->PrincipalId,
+    Contact                    => $shawn->PrincipalId,
+    'CustomField-Manufacturer' => 'Apple',
+);
+my $kaitain = create_asset(
+    Name                       => 'kaitain',
+    Description                => "unused BPS laptop",
+    Catalog                    => 'Laptops',
+    Owner                      => $shawn->PrincipalId,
+    'CustomField-Manufacturer' => 'Apple',
+);
+my $morelax = create_asset(
+    Name                       => 'morelax',
+    Description                => "BPS in the data center",
+    Catalog                    => 'Servers',
+    'CustomField-Manufacturer' => 'Dell',
+);
+my $stilgar = create_asset(
+    Name                       => 'stilgar',
+    Description                => "English layout",
+    Catalog                    => 'Keyboards',
+    Owner                      => $shawn->PrincipalId,
+    Contact                    => $shawn->PrincipalId,
+    'CustomField-Manufacturer' => 'Apple',
+);
+
+($ok, $msg) = $bloc->SetStatus('stolen');
+ok($ok, $msg);
+
+($ok, $msg) = $deleted->SetStatus('deleted');
+ok($ok, $msg);
+
+($ok, $msg) = $ecaz->SetStatus('in-use');
+ok($ok, $msg);
+
+($ok, $msg) = $kaitain->SetStatus('in-use');
+ok($ok, $msg);
+($ok, $msg) = $kaitain->SetStatus('recycled');
+ok($ok, $msg);
+
+($ok, $msg) = $morelax->SetStatus('in-use');
+ok($ok, $msg);
+
+($ok, $msg) = $ecaz->AddLink(Type => 'RefersTo', Target => $kaitain->URI);
+ok($ok, $msg);
+
+($ok, $msg) = $stilgar->AddLink(Type => 'MemberOf', Target => $ecaz->URI);
+ok($ok, $msg);
+
+my $ticket = RT::Ticket->new(RT->SystemUser);
+($ok, $msg) = $ticket->Create(Queue => 'General', Subject => "reboot the server please");
+
+($ok, $msg) = $morelax->AddLink(Type => 'RefersTo', Target => $ticket->URI);
+ok($ok, $msg);
+
+sub assetsql {
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+    my $sql = shift;
+    my @expected = @_;
+
+    my $count = scalar @expected;
+
+    my $assets = RT::Assets->new(RT->SystemUser);
+    $assets->FromSQL($sql);
+    $assets->OrderBy( FIELD => 'Name', ORDER => 'ASC' );
+
+    is($assets->Count, $count, "number of assets from [$sql]");
+    my $i = 0;
+    while (my $asset = $assets->Next) {
+        my $expected = shift @expected;
+        if (!$expected) {
+            fail("got more assets (" . $asset->Name . ") than expected from [$sql]");
+            next;
+        }
+        ++$i;
+        is($asset->Name, $expected->Name, "asset ($i/$count) from [$sql]");
+    }
+    while (my $expected = shift @expected) {
+        fail("got fewer assets than expected (" . $expected->Name . ") from [$sql]");
+    }
+}
+
+assetsql("id = 1" => $bloc);
+assetsql("id != 1" => $ecaz, $kaitain, $morelax, $stilgar);
+assetsql("id = 2" => ()); # deleted
+assetsql("id < 3" => $bloc);
+assetsql("id >= 3" => $ecaz, $kaitain, $morelax, $stilgar);
+
+assetsql("Name = 'ecaz'" => $ecaz);
+assetsql("Name != 'ecaz'" => $bloc, $kaitain, $morelax, $stilgar);
+assetsql("Name = 'no match'" => ());
+assetsql("Name != 'no match'" => $bloc, $ecaz, $kaitain, $morelax, $stilgar);
+
+assetsql("Status = 'new'" => $stilgar);
+assetsql("Status = 'allocated'" => ());
+assetsql("Status = 'in-use'" => $ecaz, $morelax);
+assetsql("Status = 'recycled'" => $kaitain);
+assetsql("Status = 'stolen'" => $bloc);
+assetsql("Status = 'deleted'" => ());
+
+assetsql("Status = '__Active__'" => $ecaz, $morelax, $stilgar);
+assetsql("Status != '__Inactive__'" => $ecaz, $morelax, $stilgar);
+assetsql("Status = '__Inactive__'" => $bloc, $kaitain);
+assetsql("Status != '__Active__'" => $bloc, $kaitain);
+
+assetsql("Catalog = 'Laptops'" => $ecaz, $kaitain);
+assetsql("Catalog = 'Servers'" => $bloc, $morelax);
+assetsql("Catalog = 'Keyboards'" => $stilgar);
+assetsql("Catalog != 'Servers'" => $ecaz, $kaitain, $stilgar);
+assetsql("Catalog != 'Laptops'" => $bloc, $morelax, $stilgar);
+assetsql("Catalog != 'Keyboards'" => $bloc, $ecaz, $kaitain, $morelax);
+
+assetsql("Description LIKE 'data center'" => $morelax);
+assetsql("Description LIKE 'Shawn'" => $bloc, $ecaz);
+assetsql("Description LIKE 'media'" => $bloc);
+assetsql("Description NOT LIKE 'laptop'" => $bloc, $morelax, $stilgar);
+assetsql("Description LIKE 'deleted'" => ());
+assetsql("Description LIKE 'BPS'" => $bloc, $ecaz, $kaitain, $morelax);
+
+assetsql("Lifecycle = 'assets'" => $bloc, $ecaz, $kaitain, $morelax, $stilgar);
+assetsql("Lifecycle != 'assets'" => ());
+assetsql("Lifecycle = 'default'" => ());
+assetsql("Lifecycle != 'default'" => $bloc, $ecaz, $kaitain, $morelax, $stilgar);
+
+assetsql("Linked IS NOT NULL" => $ecaz, $kaitain, $morelax, $stilgar);
+assetsql("Linked IS NULL" => $bloc);
+assetsql("RefersTo = 'asset:" . $kaitain->id . "'" => $ecaz);
+assetsql("RefersTo = " . $ticket->Id => $morelax);
+assetsql("HasMember = 'asset:" . $stilgar->id . "'" => $ecaz);
+assetsql("MemberOf = 'asset:" . $stilgar->id . "'" => ());
+
+assetsql("Owner.Name = 'shawn'" => $bloc, $ecaz, $kaitain, $stilgar);
+assetsql("Owner.EmailAddress LIKE 'bestpractical'" => $bloc, $ecaz, $kaitain, $stilgar);
+assetsql("Owner.Name = 'Nobody'" => $morelax);
+
+assetsql("Contact.Name = 'shawn'" => $bloc, $ecaz, $stilgar);
+
+assetsql("CustomField.{Manufacturer} = 'Apple'" => $ecaz, $kaitain, $stilgar);
+assetsql("CF.{Manufacturer} != 'Apple'" => $bloc, $morelax);
+assetsql("CustomFieldValue.{Manufacturer} = 'Raspberry Pi'" => $bloc);
+assetsql("CF.{Manufacturer} IS NULL" => ());
+
+assetsql("CF.{Blank} IS NULL" => $bloc, $ecaz, $kaitain, $morelax, $stilgar);
+assetsql("CF.{Blank} IS NOT NULL" => ());
+
+assetsql("Status = '__Active__' AND Catalog = 'Servers'" => $morelax);
+assetsql("Status = 'in-use' AND Catalog = 'Laptops'" => $ecaz);
+assetsql("Catalog != 'Servers' AND Catalog != 'Laptops'" => $stilgar);
+assetsql("Description LIKE 'BPS' AND Contact.Name IS NULL" => $kaitain, $morelax);
+assetsql("CF.{Manufacturer} = 'Apple' AND Catalog = 'Laptops'" => $ecaz, $kaitain);
+assetsql("Catalog = 'Servers' AND Linked IS NULL" => $bloc);
+assetsql("Catalog = 'Servers' OR Linked IS NULL" => $bloc, $morelax);
+assetsql("(Catalog = 'Keyboards' AND CF.{Manufacturer} = 'Apple') OR (Catalog = 'Servers' AND CF.{Manufacturer} = 'Raspberry Pi')" => $bloc, $stilgar);
+

-----------------------------------------------------------------------


More information about the Bps-public-commit mailing list