[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