[Bps-public-commit] rt-extension-assets-import-csv branch, master, created. a449381ac75c84b03254cc1433794a7e6152afb8
Alex Vandiver
alexmv at bestpractical.com
Mon Sep 30 14:49:20 EDT 2013
The branch, master has been created
at a449381ac75c84b03254cc1433794a7e6152afb8 (commit)
- Log -----------------------------------------------------------------
commit 8cae8f209ef84bd2e3ba6a8d167264a0ef49a4d0
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Dec 21 08:35:24 2012 -0800
Initial import
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..8eb2c58
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+blib*
+Makefile
+Makefile.old
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+/RT-Extension-Assets*
+*.bak
+*.swp
+/MYMETA.*
+/xt/tmp/
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..05b1c8e
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,26 @@
+---
+abstract: 'RT Extension-Assets-Import Extension'
+author:
+ - 'sunnavy <sunnavy at bestpractical.com>'
+build_requires:
+ ExtUtils::MakeMaker: 6.36
+configure_requires:
+ ExtUtils::MakeMaker: 6.36
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: gplv2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: RT-Extension-Assets-Import
+no_index:
+ directory:
+ - inc
+requires:
+ RT::Extension::Assets: 0
+ Text::CSV: 0
+ Text::CSV_XS: 0
+resources:
+ license: http://opensource.org/licenses/gpl-license.php
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..1763169
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,14 @@
+use inc::Module::Install;
+
+
+RTx 'RT-Extension-Assets-Import';
+all_from 'lib/RT/Extension/Assets/Import.pm';
+readme_from 'lib/RT/Extension/Assets/Import.pm';
+license 'gplv2';
+
+requires 'RT::Extension::Assets';
+requires 'Text::CSV';
+requires 'Text::CSV_XS';
+
+sign;
+WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..e78ebc9
--- /dev/null
+++ b/README
@@ -0,0 +1,57 @@
+NAME
+ RT-Extension-Assets-Import - RT Assets Import
+
+INSTALLATION
+ perl Makefile.PL
+ make
+ make install
+ May need root permissions
+
+ make initdb
+ Only run this the first time you install this module.
+
+ If you run this twice, you may end up with duplicate data in your
+ database.
+
+ If you are upgrading this module, check for upgrading instructions
+ in case changes need to be made to your database.
+
+ Edit your /opt/rt4/etc/RT_SiteConfig.pm
+ Add this line:
+
+ Set(@Plugins, qw(RT::Extension::Assets::Import));
+
+ or add "RT::Extension::Assets::Import" to your existing @Plugins
+ line.
+
+ Configure imported fields:
+
+ Set( $AssetsImportIdentifiedField, 'Service Tag', );
+ Set( @AssetsImportRequiredFields, 'Service Tag', );
+ Set( %AssetsImportFieldMapping,
+ # 'CSV field name' => 'RT custom field name'
+ 'serviceTag' => 'Service Tag',
+ 'building' => 'Location',
+ 'serialNo' => 'Serial #',
+ );
+
+ Clear your mason cache
+ rm -rf /opt/rt4/var/mason_data/obj
+
+ Restart your webserver
+
+AUTHOR
+ sunnavy <sunnavy at bestpractical.com>
+
+BUGS
+ All bugs should be reported via
+ <http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-Assets-Im
+ port> or bug-RT-Extension-Assets-Import at rt.cpan.org.
+
+LICENSE AND COPYRIGHT
+ This software is Copyright (c) 2012 by Best Practical Solutions
+
+ This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
diff --git a/bin/rt-assets-import b/bin/rt-assets-import
new file mode 100644
index 0000000..aceb60d
--- /dev/null
+++ b/bin/rt-assets-import
@@ -0,0 +1,62 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+use lib '/opt/rt4/local/lib', '/opt/rt4/lib';
+
+use Getopt::Long;
+my %opt;
+GetOptions( \%opt, 'help|h', 'update|u', 'debug|d' );
+my $file = shift @ARGV;
+
+if ( $opt{help} || !$file ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+use RT;
+use RT::Extension::Assets::Import;
+use RT::Interface::CLI qw(CleanEnv GetCurrentUser);
+
+CleanEnv();
+
+RT->LoadConfig();
+
+RT->Config->Set( LogToScreen => $opt{debug} ? 'debug' : 'warning' );
+
+RT->Init();
+
+my $current_user = GetCurrentUser();
+
+unless ( $current_user->Id ) {
+ print "No RT user found. Please consult your RT administrator.";
+ exit(1);
+}
+
+my ( $created, $updated, $skipped ) = RT::Extension::Assets::Import->run(
+ CurrentUser => $current_user,
+ File => $file,
+ Update => $opt{update},
+);
+
+print <<"EOF";
+created: $created
+updated: $updated
+skipped: $skipped
+EOF
+
+__END__
+
+=head1 NAME
+
+rt-assets-import - import assets to rt
+
+=head1 SYNOPSIS
+
+ rt-assets-import /path/to/assets.csv
+ rt-assets-import --update /path/to/assets.csv
+
+=head1 DESCRIPTION
+
+This script will import/update assets in csv to rt
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..4ecf46b
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,470 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.005;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '1.06';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
+
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+ }
+
+
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+ #-------------------------------------------------------------
+
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+
+ #-------------------------------------------------------------
+
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
+
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ $should_reload = 1;
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+ local *FH;
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[1]) <=> _version($_[2]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..802844a
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.06';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..22167b8
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,154 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# Check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..bee0c4f
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..7052f36
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,418 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
+sub makemaker_args {
+ my ($self, %new_args) = @_;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
+ return $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = shift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub _wanted_t {
+}
+
+sub tests_recursive {
+ my $self = shift;
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
+ require File::Find;
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ if ( $self->tests ) {
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
+ }
+ if ( $] >= 5.005 ) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
+ }
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ if ( $self->makemaker(6.17) and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
+
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
+ if ($self->bundles) {
+ my %processed;
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
+ }
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
+ }
+
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
+
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if ( my $preop = $self->admin->preop($user_preop) ) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
+ my $makefile = do { local $/; <MAKEFILE> };
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..58430f3
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,722 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
+ }
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
+ return 1;
+}
+
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the really old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ $self->{values}{all_from} = $file;
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless @{$self->author || []};
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
+}
+
+sub abstract_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub _extract_perl_version {
+ if (
+ $_[0] =~ m/
+ ^\s*
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
+ }
+ }
+ return '';
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
+}
+
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than one bugtracker link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..ce01018
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,211 @@
+#line 1
+package Module::Install::RTx;
+
+use 5.008;
+use strict;
+use warnings;
+no warnings 'once';
+
+use Module::Install::Base;
+use base 'Module::Install::Base';
+our $VERSION = '0.30';
+
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+my @DIRS = qw(etc lib html bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
+sub RTx {
+ my ( $self, $name ) = @_;
+
+ my $original_name = $name;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ unless $self->version;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ } else {
+ local @INC = (
+ $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ @INC,
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+ } grep $_, @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $_ =~ s/\/RT\.pm$//;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ my $local_lib_path = "$RT::LocalPath/lib";
+ print "Using RT configuration from $INC{'RT.pm'}:\n";
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+ unshift @INC, $lib_path;
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
+ }
+
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ }
+
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
+
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
+ File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
+ $has_etc{schema}++;
+ }
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
+ $has_etc{acl}++;
+ }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+
+ $self->postamble("$postamble\n");
+ unless ( $subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+ }
+
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ }
+}
+
+# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
+{ my %word = (
+ a => -4,
+ alpha => -4,
+ b => -3,
+ beta => -3,
+ pre => -2,
+ rc => -1,
+ head => 9999,
+);
+sub cmp_version($$) {
+ my ($a, $b) = (@_);
+ my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $a;
+ my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $b;
+ @a > @b
+ ? push @b, (0) x (@a- at b)
+ : push @a, (0) x (@b- at a);
+ for ( my $i = 0; $i < @a; $i++ ) {
+ return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
+ }
+ return 0;
+}}
+sub requires_rt {
+ my ($self,$version) = @_;
+
+ # if we're exactly the same version as what we want, silently return
+ return if ($version eq $RT::VERSION);
+
+ my @sorted = sort cmp_version $version,$RT::VERSION;
+
+ if ($sorted[-1] eq $version) {
+ # should we die?
+ warn "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ }
+}
+
+1;
+
+__END__
+
+#line 328
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
new file mode 100644
index 0000000..6a80818
--- /dev/null
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -0,0 +1,138 @@
+#line 1
+package Module::Install::ReadmeFromPod;
+
+use 5.006;
+use strict;
+use warnings;
+use base qw(Module::Install::Base);
+use vars qw($VERSION);
+
+$VERSION = '0.20';
+
+sub readme_from {
+ my $self = shift;
+ return unless $self->is_admin;
+
+ # Input file
+ my $in_file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
+
+ # Get optional arguments
+ my ($clean, $format, $out_file, $options);
+ my $args = shift;
+ if ( ref $args ) {
+ # Arguments are in a hashref
+ if ( ref($args) ne 'HASH' ) {
+ die "Expected a hashref but got a ".ref($args)."\n";
+ } else {
+ $clean = $args->{'clean'};
+ $format = $args->{'format'};
+ $out_file = $args->{'output_file'};
+ $options = $args->{'options'};
+ }
+ } else {
+ # Arguments are in a list
+ $clean = $args;
+ $format = shift;
+ $out_file = shift;
+ $options = \@_;
+ }
+
+ # Default values;
+ $clean ||= 0;
+ $format ||= 'txt';
+
+ # Generate README
+ print "readme_from $in_file to $format\n";
+ if ($format =~ m/te?xt/) {
+ $out_file = $self->_readme_txt($in_file, $out_file, $options);
+ } elsif ($format =~ m/html?/) {
+ $out_file = $self->_readme_htm($in_file, $out_file, $options);
+ } elsif ($format eq 'man') {
+ $out_file = $self->_readme_man($in_file, $out_file, $options);
+ } elsif ($format eq 'pdf') {
+ $out_file = $self->_readme_pdf($in_file, $out_file, $options);
+ }
+
+ if ($clean) {
+ $self->clean_files($out_file);
+ }
+
+ return 1;
+}
+
+
+sub _readme_txt {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README';
+ require Pod::Text;
+ my $parser = Pod::Text->new( @$options );
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ $parser->output_fh( *$out_fh );
+ $parser->parse_file( $in_file );
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _readme_htm {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.htm';
+ require Pod::Html;
+ Pod::Html::pod2html(
+ "--infile=$in_file",
+ "--outfile=$out_file",
+ @$options,
+ );
+ # Remove temporary files if needed
+ for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
+ if (-e $file) {
+ unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
+ }
+ }
+ return $out_file;
+}
+
+
+sub _readme_man {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.1';
+ require Pod::Man;
+ my $parser = Pod::Man->new( @$options );
+ $parser->parse_from_file($in_file, $out_file);
+ return $out_file;
+}
+
+
+sub _readme_pdf {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.pdf';
+ eval { require App::pod2pdf; }
+ or die "Could not generate $out_file because pod2pdf could not be found\n";
+ my $parser = App::pod2pdf->new( @$options );
+ $parser->parse_from_file($in_file);
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ select $out_fh;
+ $parser->output;
+ select STDOUT;
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
+}
+
+'Readme!';
+
+__END__
+
+#line 254
+
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..eeaa3fe
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..85d8018
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,63 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
+ }
+
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
+}
+
+1;
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
new file mode 100644
index 0000000..ca88c85
--- /dev/null
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -0,0 +1,215 @@
+use strict;
+use warnings;
+
+package RT::Extension::Assets::Import;
+
+our $VERSION = '0.01';
+
+sub run {
+ my $class = shift;
+ my %args = (
+ CurrentUser => undef,
+ File => undef,
+ Update => undef,
+ @_,
+ );
+
+ my $identified_field = RT->Config->Get('AssetsImportIdentifiedField');
+ unless ($identified_field) {
+ $RT::Logger->error(
+'Missing identified field, please set config AssetsImportIdentifiedField'
+ );
+ }
+
+ my $identified_cf = RT::CustomField->new( $args{CurrentUser} );
+ $identified_cf->LoadByCols(
+ Name => $identified_field,
+ LookupType => 'RT::Asset',
+ );
+
+ my @items = $class->parse_csv( $args{File} );
+
+ my $map = RT->Config->Get('AssetsImportFieldMapping');
+ my $r_map = { reverse %$map };
+
+ my $required_fields = RT->Config->Get('AssetsImportRequiredFields') || [];
+
+ my ( $created, $updated, $skipped ) = (0) x 3;
+
+ my $first = 1;
+
+ $RT::Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
+
+ my $i = 0;
+ OUTER:
+ for my $item (@items) {
+ $i++;
+
+ if ($first) {
+ for my $field ( keys %$item ) {
+ my $cf = RT::CustomField->new( $args{CurrentUser} );
+ $cf->LoadByCols(
+ Name => $map->{$field},
+ LookupType => 'RT::Asset',
+ );
+ unless ( $cf->id ) {
+ $RT::Logger->debug(
+ "Missing custom field $map->{$field}, skipping");
+ }
+ }
+ $first = 0;
+ }
+
+ for my $field (@$required_fields) {
+ unless ( $item->{ $r_map->{$field} } ) {
+ $RT::Logger->debug(
+ "Missing $r_map->{$field} at row $i, skipping");
+ $skipped++;
+ next OUTER;
+ }
+ }
+
+ my $asset;
+ my $assets = RT::Assets->new( $args{CurrentUser} );
+ $assets->LimitCustomField(
+ CUSTOMFIELD => $identified_cf->id,
+ VALUE => $item->{$r_map->{$identified_field}},
+ );
+
+ if ( $assets->Count ) {
+ if ( $assets->Count > 1 ) {
+ $RT::Logger->debug(
+ 'Found multiple assets with the condition');
+ }
+ unless ( $args{Update} ) {
+ $RT::Logger->debug(
+"Found existing asset at row $i but without 'Update' option, skipping."
+ );
+ $skipped++;
+ next;
+ }
+
+ $asset = $assets->First;
+ $updated++;
+ }
+ else {
+ $asset = RT::Asset->new( $args{CurrentUser} );
+ $asset->Create();
+ $created++;
+ }
+
+ for my $field ( keys %$item ) {
+ if ( defined $item->{$field} ) {
+ $asset->AddCustomFieldValue(
+ Field => $map->{$field},
+ Value => $item->{$field},
+ );
+ }
+ }
+ }
+ return ( $created, $updated, $skipped );
+}
+
+sub parse_csv {
+ my $class = shift;
+ my $file = shift;
+ require Text::CSV;
+
+ my @rows;
+ my $csv = Text::CSV->new( { binary => 1 } );
+
+ open my $fh, '<', $file or die "failed to read $file: $!";
+ my $header = $csv->getline($fh);
+
+ my @items;
+ while ( my $row = $csv->getline($fh) ) {
+ my $item;
+ for ( my $i = 0 ; $i < @$header ; $i++ ) {
+ if ( $header->[$i] ) {
+ $item->{ $header->[$i] } = $row->[$i];
+ }
+ }
+
+ push @items, $item;
+ }
+
+ $csv->eof or $csv->error_diag();
+ close $fh;
+ return @items;
+}
+
+=head1 NAME
+
+RT-Extension-Assets-Import - RT Assets Import
+
+=head1 INSTALLATION
+
+=over
+
+=item perl Makefile.PL
+
+=item make
+
+=item make install
+
+May need root permissions
+
+=item make initdb
+
+Only run this the first time you install this module.
+
+If you run this twice, you may end up with duplicate data
+in your database.
+
+If you are upgrading this module, check for upgrading instructions
+in case changes need to be made to your database.
+
+=item Edit your /opt/rt4/etc/RT_SiteConfig.pm
+
+Add this line:
+
+ Set(@Plugins, qw(RT::Extension::Assets::Import));
+
+or add C<RT::Extension::Assets::Import> to your existing C<@Plugins> line.
+
+Configure imported fields:
+
+ Set( $AssetsImportIdentifiedField, 'Service Tag', );
+ Set( @AssetsImportRequiredFields, 'Service Tag', );
+ Set( %AssetsImportFieldMapping,
+ # 'CSV field name' => 'RT custom field name'
+ 'serviceTag' => 'Service Tag',
+ 'building' => 'Location',
+ 'serialNo' => 'Serial #',
+ );
+
+=item Clear your mason cache
+
+ rm -rf /opt/rt4/var/mason_data/obj
+
+=item Restart your webserver
+
+=back
+
+=head1 AUTHOR
+
+sunnavy <sunnavy at bestpractical.com>
+
+=head1 BUGS
+
+All bugs should be reported via
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-Assets-Import>
+or L<bug-RT-Extension-Assets-Import at rt.cpan.org>.
+
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is Copyright (c) 2012 by Best Practical Solutions
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
+=cut
+
+1;
commit 2d0b4d025e27757aaa1dcaa9ff80349bf133f42a
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 08:50:16 2012 -0800
Mark as executable
diff --git a/bin/rt-assets-import b/bin/rt-assets-import
old mode 100644
new mode 100755
commit 61bb988ccfe782b9e9489242d5adf2d71cdd2118
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 08:53:21 2012 -0800
Wait until plugin paths are setup to load the import extension
diff --git a/bin/rt-assets-import b/bin/rt-assets-import
index aceb60d..8c44225 100755
--- a/bin/rt-assets-import
+++ b/bin/rt-assets-import
@@ -16,7 +16,6 @@ if ( $opt{help} || !$file ) {
}
use RT;
-use RT::Extension::Assets::Import;
use RT::Interface::CLI qw(CleanEnv GetCurrentUser);
CleanEnv();
@@ -27,6 +26,8 @@ RT->Config->Set( LogToScreen => $opt{debug} ? 'debug' : 'warning' );
RT->Init();
+require RT::Extension::Assets::Import;
+
my $current_user = GetCurrentUser();
unless ( $current_user->Id ) {
commit d5ff1c453ec62bc4cb0240a8bf5909478960bf80
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 08:53:44 2012 -0800
More readable error with a trailing newline
diff --git a/bin/rt-assets-import b/bin/rt-assets-import
index 8c44225..0099500 100755
--- a/bin/rt-assets-import
+++ b/bin/rt-assets-import
@@ -31,7 +31,7 @@ require RT::Extension::Assets::Import;
my $current_user = GetCurrentUser();
unless ( $current_user->Id ) {
- print "No RT user found. Please consult your RT administrator.";
+ print "No RT user found. Please consult your RT administrator.\n";
exit(1);
}
commit 62ffbaa2ee03f7274bde9910d166a6188396c568
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 08:58:15 2012 -0800
These are warnings, not messages that should be hidden behind debug
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
index ca88c85..a9bee4b 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -53,7 +53,7 @@ sub run {
LookupType => 'RT::Asset',
);
unless ( $cf->id ) {
- $RT::Logger->debug(
+ $RT::Logger->warning(
"Missing custom field $map->{$field}, skipping");
}
}
@@ -62,7 +62,7 @@ sub run {
for my $field (@$required_fields) {
unless ( $item->{ $r_map->{$field} } ) {
- $RT::Logger->debug(
+ $RT::Logger->warning(
"Missing $r_map->{$field} at row $i, skipping");
$skipped++;
next OUTER;
@@ -78,7 +78,7 @@ sub run {
if ( $assets->Count ) {
if ( $assets->Count > 1 ) {
- $RT::Logger->debug(
+ $RT::Logger->warning(
'Found multiple assets with the condition');
}
unless ( $args{Update} ) {
commit df07bed14a6ef4909e5b508d41b0bfb5a5aadead
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 08:58:52 2012 -0800
Switch to 4.0 style RT->Logger
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
index a9bee4b..41cf27a 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -16,7 +16,7 @@ sub run {
my $identified_field = RT->Config->Get('AssetsImportIdentifiedField');
unless ($identified_field) {
- $RT::Logger->error(
+ RT->Logger->error(
'Missing identified field, please set config AssetsImportIdentifiedField'
);
}
@@ -38,7 +38,7 @@ sub run {
my $first = 1;
- $RT::Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
+ RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
my $i = 0;
OUTER:
@@ -53,7 +53,7 @@ sub run {
LookupType => 'RT::Asset',
);
unless ( $cf->id ) {
- $RT::Logger->warning(
+ RT->Logger->warning(
"Missing custom field $map->{$field}, skipping");
}
}
@@ -62,7 +62,7 @@ sub run {
for my $field (@$required_fields) {
unless ( $item->{ $r_map->{$field} } ) {
- $RT::Logger->warning(
+ RT->Logger->warning(
"Missing $r_map->{$field} at row $i, skipping");
$skipped++;
next OUTER;
@@ -78,11 +78,11 @@ sub run {
if ( $assets->Count ) {
if ( $assets->Count > 1 ) {
- $RT::Logger->warning(
+ RT->Logger->warning(
'Found multiple assets with the condition');
}
unless ( $args{Update} ) {
- $RT::Logger->debug(
+ RT->Logger->debug(
"Found existing asset at row $i but without 'Update' option, skipping."
);
$skipped++;
commit 729f35f197ee0fc054c4b941040ae27a98a7785a
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 09:09:34 2012 -0800
Bail on fatal errors
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
index 41cf27a..cac9cb3 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -19,6 +19,7 @@ sub run {
RT->Logger->error(
'Missing identified field, please set config AssetsImportIdentifiedField'
);
+ return (0,0,0);
}
my $identified_cf = RT::CustomField->new( $args{CurrentUser} );
@@ -26,6 +27,11 @@ sub run {
Name => $identified_field,
LookupType => 'RT::Asset',
);
+ unless ($identified_cf->id) {
+ RT->Logger->error(
+ "Unable to load identified field, please check that it exists and the exact name");
+ return (0,0,0);
+ }
my @items = $class->parse_csv( $args{File} );
commit a37704ad94e75a1983ea4e72e78890a8ebacd5b7
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 09:10:05 2012 -0800
Skip fields which aren't mapped
Avoids useless warnings about missing a CF with an empty field name.
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
index cac9cb3..934a2ba 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -50,9 +50,18 @@ sub run {
OUTER:
for my $item (@items) {
$i++;
+ my @fields;
if ($first) {
- for my $field ( keys %$item ) {
+ for my $field (keys %$item) {
+ unless ($map->{$field}) {
+ RT->Logger->debug("No mapping for import field '$field', skipping");
+ next;
+ }
+ push @fields, $field;
+ }
+
+ for my $field (@fields) {
my $cf = RT::CustomField->new( $args{CurrentUser} );
$cf->LoadByCols(
Name => $map->{$field},
@@ -104,7 +113,7 @@ sub run {
$created++;
}
- for my $field ( keys %$item ) {
+ for my $field (@fields) {
if ( defined $item->{$field} ) {
$asset->AddCustomFieldValue(
Field => $map->{$field},
commit 80e2abd8c88b6df11c3ccd777353c1cfe1ec84ca
Author: Thomas Sibley <trs at bestpractical.com>
Date: Fri Dec 21 09:22:58 2012 -0800
Avoid setting empty strings as CF values
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import.pm
index 934a2ba..f20e23e 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import.pm
@@ -114,7 +114,7 @@ sub run {
}
for my $field (@fields) {
- if ( defined $item->{$field} ) {
+ if ( defined $item->{$field} and length $item->{$field} ) {
$asset->AddCustomFieldValue(
Field => $map->{$field},
Value => $item->{$field},
commit 61df5bc0fcd91282c2fe7ce9c80e5ed43762cae2
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 12:50:01 2012 -0500
Rename to be CSV specific
diff --git a/META.yml b/META.yml
index 05b1c8e..c57a342 100644
--- a/META.yml
+++ b/META.yml
@@ -1,5 +1,5 @@
---
-abstract: 'RT Extension-Assets-Import Extension'
+abstract: 'RT Extension-Assets-Import-CSV Extension'
author:
- 'sunnavy <sunnavy at bestpractical.com>'
build_requires:
@@ -13,7 +13,7 @@ license: gplv2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
-name: RT-Extension-Assets-Import
+name: RT-Extension-Assets-Import-CSV
no_index:
directory:
- inc
diff --git a/Makefile.PL b/Makefile.PL
index 1763169..11951bf 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,9 +1,9 @@
use inc::Module::Install;
-RTx 'RT-Extension-Assets-Import';
-all_from 'lib/RT/Extension/Assets/Import.pm';
-readme_from 'lib/RT/Extension/Assets/Import.pm';
+RTx 'RT-Extension-Assets-Import-CSV';
+all_from 'lib/RT/Extension/Assets/Import/CSV.pm';
+readme_from 'lib/RT/Extension/Assets/Import/CSV.pm';
license 'gplv2';
requires 'RT::Extension::Assets';
diff --git a/README b/README
index e78ebc9..675d752 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
NAME
- RT-Extension-Assets-Import - RT Assets Import
+ RT-Extension-Assets-Import-CSV - RT Assets Import from CSV
INSTALLATION
perl Makefile.PL
@@ -19,10 +19,10 @@ INSTALLATION
Edit your /opt/rt4/etc/RT_SiteConfig.pm
Add this line:
- Set(@Plugins, qw(RT::Extension::Assets::Import));
+ Set(@Plugins, qw(RT::Extension::Assets::Import::CSV));
- or add "RT::Extension::Assets::Import" to your existing @Plugins
- line.
+ or add "RT::Extension::Assets::Import::CSV" to your existing
+ @Plugins line.
Configure imported fields:
@@ -46,7 +46,7 @@ AUTHOR
BUGS
All bugs should be reported via
<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-Assets-Im
- port> or bug-RT-Extension-Assets-Import at rt.cpan.org.
+ port-CSV> or bug-RT-Extension-Assets-Import-CSV at rt.cpan.org.
LICENSE AND COPYRIGHT
This software is Copyright (c) 2012 by Best Practical Solutions
diff --git a/bin/rt-assets-import b/bin/rt-assets-import-csv
similarity index 95%
rename from bin/rt-assets-import
rename to bin/rt-assets-import-csv
index 0099500..3da0f24 100755
--- a/bin/rt-assets-import
+++ b/bin/rt-assets-import-csv
@@ -26,7 +26,7 @@ RT->Config->Set( LogToScreen => $opt{debug} ? 'debug' : 'warning' );
RT->Init();
-require RT::Extension::Assets::Import;
+require RT::Extension::Assets::Import::CSV;
my $current_user = GetCurrentUser();
@@ -35,7 +35,7 @@ unless ( $current_user->Id ) {
exit(1);
}
-my ( $created, $updated, $skipped ) = RT::Extension::Assets::Import->run(
+my ( $created, $updated, $skipped ) = RT::Extension::Assets::Import::CSV->run(
CurrentUser => $current_user,
File => $file,
Update => $opt{update},
diff --git a/lib/RT/Extension/Assets/Import.pm b/lib/RT/Extension/Assets/Import/CSV.pm
similarity index 94%
rename from lib/RT/Extension/Assets/Import.pm
rename to lib/RT/Extension/Assets/Import/CSV.pm
index f20e23e..871a862 100644
--- a/lib/RT/Extension/Assets/Import.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -1,7 +1,7 @@
use strict;
use warnings;
-package RT::Extension::Assets::Import;
+package RT::Extension::Assets::Import::CSV;
our $VERSION = '0.01';
@@ -155,7 +155,7 @@ sub parse_csv {
=head1 NAME
-RT-Extension-Assets-Import - RT Assets Import
+RT-Extension-Assets-Import-CSV - RT Assets Import from CSV
=head1 INSTALLATION
@@ -183,9 +183,9 @@ in case changes need to be made to your database.
Add this line:
- Set(@Plugins, qw(RT::Extension::Assets::Import));
+ Set(@Plugins, qw(RT::Extension::Assets::Import::CSV));
-or add C<RT::Extension::Assets::Import> to your existing C<@Plugins> line.
+or add C<RT::Extension::Assets::Import::CSV> to your existing C<@Plugins> line.
Configure imported fields:
@@ -213,8 +213,8 @@ sunnavy <sunnavy at bestpractical.com>
=head1 BUGS
All bugs should be reported via
-L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-Assets-Import>
-or L<bug-RT-Extension-Assets-Import at rt.cpan.org>.
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-Assets-Import-CSV>
+or L<bug-RT-Extension-Assets-Import-CSV at rt.cpan.org>.
=head1 LICENSE AND COPYRIGHT
commit 9ee44b3076c39b4744baf2c7452e6348589b6a2a
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:05:12 2012 -0500
No need to include both Text::CSV and Text::CSV_XS
Text::CSV_XS is a separate module, which is not used automagically in
preference to Text::CSV. Explicitly use Text::CSV_XS.
diff --git a/META.yml b/META.yml
index c57a342..547f227 100644
--- a/META.yml
+++ b/META.yml
@@ -19,7 +19,6 @@ no_index:
- inc
requires:
RT::Extension::Assets: 0
- Text::CSV: 0
Text::CSV_XS: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
diff --git a/Makefile.PL b/Makefile.PL
index 11951bf..f00f35f 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,7 +7,6 @@ readme_from 'lib/RT/Extension/Assets/Import/CSV.pm';
license 'gplv2';
requires 'RT::Extension::Assets';
-requires 'Text::CSV';
requires 'Text::CSV_XS';
sign;
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 871a862..4e90bf1 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -2,6 +2,7 @@ use strict;
use warnings;
package RT::Extension::Assets::Import::CSV;
+use Text::CSV_XS;
our $VERSION = '0.01';
@@ -128,10 +129,9 @@ sub run {
sub parse_csv {
my $class = shift;
my $file = shift;
- require Text::CSV;
my @rows;
- my $csv = Text::CSV->new( { binary => 1 } );
+ my $csv = Text::CSV_XS->new( { binary => 1 } );
open my $fh, '<', $file or die "failed to read $file: $!";
my $header = $csv->getline($fh);
commit 5121f47555ae7cdc411b92e23485a3d5b244a3dc
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:13:16 2012 -0500
This config option is renamed in 4.2
diff --git a/bin/rt-assets-import-csv b/bin/rt-assets-import-csv
index 3da0f24..dd20b99 100755
--- a/bin/rt-assets-import-csv
+++ b/bin/rt-assets-import-csv
@@ -21,9 +21,7 @@ use RT::Interface::CLI qw(CleanEnv GetCurrentUser);
CleanEnv();
RT->LoadConfig();
-
-RT->Config->Set( LogToScreen => $opt{debug} ? 'debug' : 'warning' );
-
+RT->Config->Set( LogToSTDERR => $opt{debug} ? 'debug' : 'warning' );
RT->Init();
require RT::Extension::Assets::Import::CSV;
commit c527f843efd42e4ef0520097041dfc77d25235a4
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:13:53 2012 -0500
Use the logger to report errors, not print
diff --git a/bin/rt-assets-import-csv b/bin/rt-assets-import-csv
index dd20b99..5b8b50a 100755
--- a/bin/rt-assets-import-csv
+++ b/bin/rt-assets-import-csv
@@ -29,7 +29,7 @@ require RT::Extension::Assets::Import::CSV;
my $current_user = GetCurrentUser();
unless ( $current_user->Id ) {
- print "No RT user found. Please consult your RT administrator.\n";
+ RT->Logger->error("No RT user found. Please consult your RT administrator.");
exit(1);
}
commit d683b4396be78c637b2283167c706517321ec058
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:20:13 2012 -0500
Improve error message for no AssetsImportIdentifiedField CF found
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 4e90bf1..f53e746 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -29,9 +29,8 @@ sub run {
LookupType => 'RT::Asset',
);
unless ($identified_cf->id) {
- RT->Logger->error(
- "Unable to load identified field, please check that it exists and the exact name");
- return (0,0,0);
+ RT->Logger->error( "Can't find custom field $identified_field for RT::Assets" );
+ return (0, 0, 0);
}
my @items = $class->parse_csv( $args{File} );
commit 6dd5b3c2e1878eec080e441b923dbc15643f2d65
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:23:24 2012 -0500
No need to make people set the same CF in two places
If a need for having additional required fields arises, the config can
be re-added trivially.
diff --git a/README b/README
index 675d752..f5f6c4d 100644
--- a/README
+++ b/README
@@ -27,7 +27,6 @@ INSTALLATION
Configure imported fields:
Set( $AssetsImportIdentifiedField, 'Service Tag', );
- Set( @AssetsImportRequiredFields, 'Service Tag', );
Set( %AssetsImportFieldMapping,
# 'CSV field name' => 'RT custom field name'
'serviceTag' => 'Service Tag',
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index f53e746..b8211a6 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -38,7 +38,7 @@ sub run {
my $map = RT->Config->Get('AssetsImportFieldMapping');
my $r_map = { reverse %$map };
- my $required_fields = RT->Config->Get('AssetsImportRequiredFields') || [];
+ my @required_columns = map { $r_map->{$_} } $identified_field;
my ( $created, $updated, $skipped ) = (0) x 3;
@@ -47,7 +47,6 @@ sub run {
RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
my $i = 0;
- OUTER:
for my $item (@items) {
$i++;
my @fields;
@@ -75,13 +74,12 @@ sub run {
$first = 0;
}
- for my $field (@$required_fields) {
- unless ( $item->{ $r_map->{$field} } ) {
- RT->Logger->warning(
- "Missing $r_map->{$field} at row $i, skipping");
- $skipped++;
- next OUTER;
- }
+ my @missing = grep {not $item->{$_}} @required_columns;
+ if (@missing) {
+ RT->Logger->warning(
+ "Missing value for required column@{[@missing > 1 ? 's':'']} @missing at row $i, skipping");
+ $skipped++;
+ next;
}
my $asset;
@@ -189,7 +187,6 @@ or add C<RT::Extension::Assets::Import::CSV> to your existing C<@Plugins> line.
Configure imported fields:
Set( $AssetsImportIdentifiedField, 'Service Tag', );
- Set( @AssetsImportRequiredFields, 'Service Tag', );
Set( %AssetsImportFieldMapping,
# 'CSV field name' => 'RT custom field name'
'serviceTag' => 'Service Tag',
commit c9f0a9f7ad2d7e921dbf90154c93902e286f5604
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:28:13 2012 -0500
Remove need to a magic "first" variable
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index b8211a6..06e4fff 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -33,46 +33,38 @@ sub run {
return (0, 0, 0);
}
- my @items = $class->parse_csv( $args{File} );
-
my $map = RT->Config->Get('AssetsImportFieldMapping');
my $r_map = { reverse %$map };
my @required_columns = map { $r_map->{$_} } $identified_field;
- my ( $created, $updated, $skipped ) = (0) x 3;
+ my @items = $class->parse_csv( $args{File} );
+ RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
- my $first = 1;
+ my %cfmap;
+ for my $field ( keys %{ $items[0] } ) {
+ my $cf = RT::CustomField->new( $args{CurrentUser} );
+ unless ($map->{$field}) {
+ RT->Logger->debug( "No mapping for import field '$field', skipping" );
+ next;
+ }
+ $cf->LoadByCols(
+ Name => $map->{$field},
+ LookupType => 'RT::Asset',
+ );
+ if ( $cf->id ) {
+ $cfmap{$field} = $cf->id;
+ } else {
+ RT->Logger->warning(
+ "Missing custom field $map->{$field} for column $field, skipping");
+ }
+ }
- RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
+ my ( $created, $updated, $skipped ) = (0) x 3;
my $i = 0;
for my $item (@items) {
$i++;
- my @fields;
-
- if ($first) {
- for my $field (keys %$item) {
- unless ($map->{$field}) {
- RT->Logger->debug("No mapping for import field '$field', skipping");
- next;
- }
- push @fields, $field;
- }
-
- for my $field (@fields) {
- my $cf = RT::CustomField->new( $args{CurrentUser} );
- $cf->LoadByCols(
- Name => $map->{$field},
- LookupType => 'RT::Asset',
- );
- unless ( $cf->id ) {
- RT->Logger->warning(
- "Missing custom field $map->{$field}, skipping");
- }
- }
- $first = 0;
- }
my @missing = grep {not $item->{$_}} @required_columns;
if (@missing) {
@@ -111,10 +103,10 @@ sub run {
$created++;
}
- for my $field (@fields) {
- if ( defined $item->{$field} and length $item->{$field} ) {
+ for my $field ( keys %$item ) {
+ if ( defined $item->{$field} and length $item->{$field} and $cfmap{$field} ) {
$asset->AddCustomFieldValue(
- Field => $map->{$field},
+ Field => $cfmap{$field},
Value => $item->{$field},
);
}
commit 22ebf18ecfaf9072a1302ed4706649e71f82e5b1
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:30:15 2012 -0500
Skip the create if multiple matching assets are found
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 06e4fff..0128c36 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -85,6 +85,8 @@ sub run {
if ( $assets->Count > 1 ) {
RT->Logger->warning(
'Found multiple assets with the condition');
+ $skipped++;
+ next;
}
unless ( $args{Update} ) {
RT->Logger->debug(
commit c25eb8fdc8d4d17f2a188ff06049733827cb7fd7
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:31:08 2012 -0500
Improve warning messages and error detection
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 0128c36..b20010a 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -76,21 +76,23 @@ sub run {
my $asset;
my $assets = RT::Assets->new( $args{CurrentUser} );
+ my $id_value = $item->{$r_map->{$identified_field}};
$assets->LimitCustomField(
CUSTOMFIELD => $identified_cf->id,
- VALUE => $item->{$r_map->{$identified_field}},
+ VALUE => $id_value,
);
if ( $assets->Count ) {
if ( $assets->Count > 1 ) {
RT->Logger->warning(
- 'Found multiple assets with the condition');
+ "Found multiple assets for identifying CF $identified_field = $id_value"
+ );
$skipped++;
next;
}
unless ( $args{Update} ) {
RT->Logger->debug(
-"Found existing asset at row $i but without 'Update' option, skipping."
+ "Found existing asset at row $i but without 'Update' option, skipping."
);
$skipped++;
next;
@@ -98,19 +100,25 @@ sub run {
$asset = $assets->First;
$updated++;
- }
- else {
+ } else {
$asset = RT::Asset->new( $args{CurrentUser} );
- $asset->Create();
- $created++;
+ my ($ok, $msg) = $asset->Create();
+ if ($ok) {
+ $created++;
+ } else {
+ RT->Logger->error("Failed to create asset for row $i: $msg");
+ }
}
for my $field ( keys %$item ) {
if ( defined $item->{$field} and length $item->{$field} and $cfmap{$field} ) {
- $asset->AddCustomFieldValue(
+ my ($ok, $msg) = $asset->AddCustomFieldValue(
Field => $cfmap{$field},
Value => $item->{$field},
);
+ unless ($ok) {
+ RT->Logger->error("Failed to set CF ".$map->{$field}." for for $i: $msg");
+ }
}
}
}
commit 91a72a3ed428c225979e1e56db85171b7aad891e
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 13:32:33 2012 -0500
This extension has no web UI; remove steps from install
diff --git a/README b/README
index f5f6c4d..657377b 100644
--- a/README
+++ b/README
@@ -34,11 +34,6 @@ INSTALLATION
'serialNo' => 'Serial #',
);
- Clear your mason cache
- rm -rf /opt/rt4/var/mason_data/obj
-
- Restart your webserver
-
AUTHOR
sunnavy <sunnavy at bestpractical.com>
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index b20010a..ee94849 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -196,12 +196,6 @@ Configure imported fields:
'serialNo' => 'Serial #',
);
-=item Clear your mason cache
-
- rm -rf /opt/rt4/var/mason_data/obj
-
-=item Restart your webserver
-
=back
=head1 AUTHOR
commit 291db80ea9a154a0bf5f1326b88ddab61f5fbe2f
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 16:20:30 2012 -0500
Invert sense of mapping
While it is non-sensical to set a CF twice (to two different columns in
the CSV) it is entirely believeably that one might want to use a CSV
column in more than once place. Invert the field mapping to make this
possible.
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index ee94849..a98d7b0 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -33,38 +33,43 @@ sub run {
return (0, 0, 0);
}
- my $map = RT->Config->Get('AssetsImportFieldMapping');
- my $r_map = { reverse %$map };
-
- my @required_columns = map { $r_map->{$_} } $identified_field;
-
- my @items = $class->parse_csv( $args{File} );
- RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
-
+ my $cf2csv = RT->Config->Get('AssetsImportFieldMapping');
+ my $csv2cf = { reverse %$cf2csv };
my %cfmap;
- for my $field ( keys %{ $items[0] } ) {
+ for my $cfname (keys %{ $cf2csv }) {
my $cf = RT::CustomField->new( $args{CurrentUser} );
- unless ($map->{$field}) {
- RT->Logger->debug( "No mapping for import field '$field', skipping" );
- next;
- }
$cf->LoadByCols(
- Name => $map->{$field},
+ Name => $cfname,
LookupType => 'RT::Asset',
);
if ( $cf->id ) {
- $cfmap{$field} = $cf->id;
+ $cfmap{$cfname} = $cf->id;
} else {
RT->Logger->warning(
- "Missing custom field $map->{$field} for column $field, skipping");
+ "Missing custom field $cfname for column $cf2csv->{$cfname}, skipping");
+ delete $cf2csv->{$cfname};
}
}
+ my @required_columns = map { $cf2csv->{$_} } $identified_field;
+ my @items = $class->parse_csv( $args{File} );
+ unless (@items) {
+ RT->Logger->warning( "No items found in file $args{File}" );
+ return (0, 0, 0);
+ }
+
+ RT->Logger->debug( "Found unused column '$_'" )
+ for grep {not $csv2cf->{$_}} keys %{ $items[0] };
+ RT->Logger->warning( "No column $_ found for CF ".$csv2cf->{$_} )
+ for grep {not exists $items[0]->{$_} } keys %{ $csv2cf };
+
+ RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
my ( $created, $updated, $skipped ) = (0) x 3;
- my $i = 0;
+ my $i = 1; # Because of header row
for my $item (@items) {
$i++;
+ next unless grep {/\S/} values %{$item};
my @missing = grep {not $item->{$_}} @required_columns;
if (@missing) {
@@ -76,7 +81,7 @@ sub run {
my $asset;
my $assets = RT::Assets->new( $args{CurrentUser} );
- my $id_value = $item->{$r_map->{$identified_field}};
+ my $id_value = $item->{$cf2csv->{$identified_field}};
$assets->LimitCustomField(
CUSTOMFIELD => $identified_cf->id,
VALUE => $id_value,
@@ -117,7 +122,7 @@ sub run {
Value => $item->{$field},
);
unless ($ok) {
- RT->Logger->error("Failed to set CF ".$map->{$field}." for for $i: $msg");
+ RT->Logger->error("Failed to set CF ".$csv2cf->{$field}." to ".$item->{$field}." for row $i: $msg");
}
}
}
@@ -188,12 +193,12 @@ or add C<RT::Extension::Assets::Import::CSV> to your existing C<@Plugins> line.
Configure imported fields:
- Set( $AssetsImportIdentifiedField, 'Service Tag', );
+ Set( $AssetsImportIdentifiedField, 'Service Tag' );
Set( %AssetsImportFieldMapping,
- # 'CSV field name' => 'RT custom field name'
- 'serviceTag' => 'Service Tag',
- 'building' => 'Location',
- 'serialNo' => 'Serial #',
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
);
=back
commit fcdb70c582cd4f9018a80138fc7c9da128aba3cc
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:19:34 2012 -0500
Rename AssetsImportIdentifiedField to the more parseable AssetsImportUniqueCF
diff --git a/README b/README
index 657377b..a572f94 100644
--- a/README
+++ b/README
@@ -26,12 +26,12 @@ INSTALLATION
Configure imported fields:
- Set( $AssetsImportIdentifiedField, 'Service Tag', );
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
Set( %AssetsImportFieldMapping,
- # 'CSV field name' => 'RT custom field name'
- 'serviceTag' => 'Service Tag',
- 'building' => 'Location',
- 'serialNo' => 'Serial #',
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
);
AUTHOR
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index a98d7b0..9c7c171 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -15,21 +15,21 @@ sub run {
@_,
);
- my $identified_field = RT->Config->Get('AssetsImportIdentifiedField');
- unless ($identified_field) {
+ my $unique = RT->Config->Get('AssetsImportUniqueCF');
+ unless ($unique) {
RT->Logger->error(
-'Missing identified field, please set config AssetsImportIdentifiedField'
+ 'Missing identified field, please set config AssetsImportUniqueCF'
);
return (0,0,0);
}
- my $identified_cf = RT::CustomField->new( $args{CurrentUser} );
- $identified_cf->LoadByCols(
- Name => $identified_field,
+ my $unique_cf = RT::CustomField->new( $args{CurrentUser} );
+ $unique_cf->LoadByCols(
+ Name => $unique,
LookupType => 'RT::Asset',
);
- unless ($identified_cf->id) {
- RT->Logger->error( "Can't find custom field $identified_field for RT::Assets" );
+ unless ($unique_cf->id) {
+ RT->Logger->error( "Can't find custom field $unique for RT::Assets" );
return (0, 0, 0);
}
@@ -51,7 +51,7 @@ sub run {
}
}
- my @required_columns = map { $cf2csv->{$_} } $identified_field;
+ my @required_columns = ( $field2csv->{"CF.$unique"} );
my @items = $class->parse_csv( $args{File} );
unless (@items) {
@@ -81,16 +81,16 @@ sub run {
my $asset;
my $assets = RT::Assets->new( $args{CurrentUser} );
- my $id_value = $item->{$cf2csv->{$identified_field}};
+ my $id_value = $item->{$cf2csv->{"CF.$unique"}};
$assets->LimitCustomField(
- CUSTOMFIELD => $identified_cf->id,
+ CUSTOMFIELD => $unique_cf->id,
VALUE => $id_value,
);
if ( $assets->Count ) {
if ( $assets->Count > 1 ) {
RT->Logger->warning(
- "Found multiple assets for identifying CF $identified_field = $id_value"
+ "Found multiple assets for $unique = $id_value"
);
$skipped++;
next;
@@ -193,7 +193,7 @@ or add C<RT::Extension::Assets::Import::CSV> to your existing C<@Plugins> line.
Configure imported fields:
- Set( $AssetsImportIdentifiedField, 'Service Tag' );
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
Set( %AssetsImportFieldMapping,
# 'RT custom field name' => 'CSV field name'
'Service Tag' => 'serviceTag',
commit 764689bc81029aae9b91b5ab874eef4397628a42
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:27:12 2012 -0500
Allow setting core fields, require that custom fields be prefixed with CF.
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 9c7c171..cf154d3 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -33,21 +33,30 @@ sub run {
return (0, 0, 0);
}
- my $cf2csv = RT->Config->Get('AssetsImportFieldMapping');
- my $csv2cf = { reverse %$cf2csv };
+ my $field2csv = RT->Config->Get('AssetsImportFieldMapping');
+ my $csv2fields = {};
+ push @{$csv2fields->{ $field2csv->{$_} }}, $_ for keys %{$field2csv};
+
my %cfmap;
- for my $cfname (keys %{ $cf2csv }) {
- my $cf = RT::CustomField->new( $args{CurrentUser} );
- $cf->LoadByCols(
- Name => $cfname,
- LookupType => 'RT::Asset',
- );
- if ( $cf->id ) {
- $cfmap{$cfname} = $cf->id;
- } else {
+ for my $fieldname (keys %{ $field2csv }) {
+ if ($fieldname =~ /^CF\.(.*)/) {
+ my $cfname = $1;
+ my $cf = RT::CustomField->new( $args{CurrentUser} );
+ $cf->LoadByCols(
+ Name => $cfname,
+ LookupType => 'RT::Asset',
+ );
+ if ( $cf->id ) {
+ $cfmap{$cfname} = $cf->id;
+ } else {
+ RT->Logger->warning(
+ "Missing custom field $cfname for column $field2csv->{$fieldname}, skipping");
+ delete $field2csv->{$fieldname};
+ }
+ } elsif ($fieldname !~ /^(Name|Status|Description|Created|LastUpdated|Owner)$/) {
RT->Logger->warning(
- "Missing custom field $cfname for column $cf2csv->{$cfname}, skipping");
- delete $cf2csv->{$cfname};
+ "Unknown asset field $fieldname for column $field2csv->{$fieldname}, skipping");
+ delete $field2csv->{$fieldname};
}
}
@@ -60,9 +69,9 @@ sub run {
}
RT->Logger->debug( "Found unused column '$_'" )
- for grep {not $csv2cf->{$_}} keys %{ $items[0] };
- RT->Logger->warning( "No column $_ found for CF ".$csv2cf->{$_} )
- for grep {not exists $items[0]->{$_} } keys %{ $csv2cf };
+ for grep {not $csv2fields->{$_}} keys %{ $items[0] };
+ RT->Logger->warning( "No column $_ found for @{$csv2fields->{$_}}" )
+ for grep {not exists $items[0]->{$_} } keys %{ $csv2fields };
RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
my ( $created, $updated, $skipped ) = (0) x 3;
@@ -79,9 +88,8 @@ sub run {
next;
}
- my $asset;
my $assets = RT::Assets->new( $args{CurrentUser} );
- my $id_value = $item->{$cf2csv->{"CF.$unique"}};
+ my $id_value = $item->{$field2csv->{"CF.$unique"}};
$assets->LimitCustomField(
CUSTOMFIELD => $unique_cf->id,
VALUE => $id_value,
@@ -103,29 +111,50 @@ sub run {
next;
}
- $asset = $assets->First;
+ my $asset = $assets->First;
+ for my $field ( keys %$field2csv ) {
+ my $value = $item->{$field2csv->{$field}};
+ next unless defined $value and length $value;
+ if ($field =~ /^CF\.(.*)/) {
+ my $cfname = $1;
+ my ($ok, $msg) = $asset->AddCustomFieldValue(
+ Field => $cfmap{$cfname},
+ Value => $value,
+ );
+ unless ($ok) {
+ RT->Logger->error("Failed to set CF $cfname to $value for row $i: $msg");
+ }
+ } elsif ($asset->$field ne $value) {
+ my $method = "Set" . $field;
+ my ($ok, $msg) = $asset->$method( $value );
+ unless ($ok) {
+ RT->Logger->error("Failed to set $field to $value for row $1: $msg");
+ }
+ }
+ }
$updated++;
} else {
- $asset = RT::Asset->new( $args{CurrentUser} );
- my ($ok, $msg) = $asset->Create();
+ my $asset = RT::Asset->new( $args{CurrentUser} );
+ my %args;
+
+ for my $field (keys %$field2csv ) {
+ my $value = $item->{$field2csv->{$field}};
+ next unless defined $value and length $value;
+ if ($field =~ /^CF\.(.*)/) {
+ my $cfname = $1;
+ $args{"CustomField-".$cfmap{$cfname}} = $value;
+ } else {
+ $args{$field} = $value;
+ }
+ }
+
+ my ($ok, $msg) = $asset->Create( %args );
if ($ok) {
$created++;
} else {
RT->Logger->error("Failed to create asset for row $i: $msg");
}
}
-
- for my $field ( keys %$item ) {
- if ( defined $item->{$field} and length $item->{$field} and $cfmap{$field} ) {
- my ($ok, $msg) = $asset->AddCustomFieldValue(
- Field => $cfmap{$field},
- Value => $item->{$field},
- );
- unless ($ok) {
- RT->Logger->error("Failed to set CF ".$csv2cf->{$field}." to ".$item->{$field}." for row $i: $msg");
- }
- }
- }
}
return ( $created, $updated, $skipped );
}
commit 2b6f136df35a4503fd2d5d9724aad5858faa874a
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:41:02 2012 -0500
Catch and display non-fatal warnings during create
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index cf154d3..8afbb91 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -148,9 +148,11 @@ sub run {
}
}
- my ($ok, $msg) = $asset->Create( %args );
+ my ($ok, $msg, $err) = $asset->Create( %args );
if ($ok) {
$created++;
+ } elsif ($err and @{$err}) {
+ RT->Logger->warning(join("\n", "Warnings during create for row $i: ", @{$err}) );
} else {
RT->Logger->error("Failed to create asset for row $i: $msg");
}
commit 7daf178b551fa16db5f72031e9f3e9cc845163b8
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:41:25 2012 -0500
Only add CF values if we don't have them already
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 8afbb91..74ceff4 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -117,6 +117,10 @@ sub run {
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
+
+ my @current = @{$asset->CustomFieldValues( $cfmap{$cfname} )->ItemsArrayRef};
+ next if grep {$_->Content and $_->Content eq $value} @current;
+
my ($ok, $msg) = $asset->AddCustomFieldValue(
Field => $cfmap{$cfname},
Value => $value,
commit 9241696ef056695e9c1bf55feff3194d5920e170
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:48:32 2012 -0500
Canonicalize datetimes and dates to save on no-op updates
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 74ceff4..4104f49 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -47,7 +47,7 @@ sub run {
LookupType => 'RT::Asset',
);
if ( $cf->id ) {
- $cfmap{$cfname} = $cf->id;
+ $cfmap{$cfname} = $cf;
} else {
RT->Logger->warning(
"Missing custom field $cfname for column $field2csv->{$fieldname}, skipping");
@@ -118,11 +118,21 @@ sub run {
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
- my @current = @{$asset->CustomFieldValues( $cfmap{$cfname} )->ItemsArrayRef};
+ if ($cfmap{$cfname}->Type eq "DateTime") {
+ my $args = { Content => $value };
+ $cfmap{$cfname}->_CanonicalizeValueDateTime( $args );
+ $value = $args->{Content};
+ } elsif ($cfmap{$cfname}->Type eq "Date") {
+ my $args = { Content => $value };
+ $cfmap{$cfname}->_CanonicalizeValueDate( $args );
+ $value = $args->{Content};
+ }
+
+ my @current = @{$asset->CustomFieldValues( $cfmap{$cfname}->id )->ItemsArrayRef};
next if grep {$_->Content and $_->Content eq $value} @current;
my ($ok, $msg) = $asset->AddCustomFieldValue(
- Field => $cfmap{$cfname},
+ Field => $cfmap{$cfname}->id,
Value => $value,
);
unless ($ok) {
@@ -146,7 +156,7 @@ sub run {
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
- $args{"CustomField-".$cfmap{$cfname}} = $value;
+ $args{"CustomField-".$cfmap{$cfname}->id} = $value;
} else {
$args{$field} = $value;
}
commit 111f3c14eabc22a9b3374fb1207f5ad927dbcff7
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Dec 21 17:48:51 2012 -0500
Only count as updated if some part of the record was changed
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 4104f49..d55c1de 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -112,6 +112,7 @@ sub run {
}
my $asset = $assets->First;
+ my $changes;
for my $field ( keys %$field2csv ) {
my $value = $item->{$field2csv->{$field}};
next unless defined $value and length $value;
@@ -131,6 +132,7 @@ sub run {
my @current = @{$asset->CustomFieldValues( $cfmap{$cfname}->id )->ItemsArrayRef};
next if grep {$_->Content and $_->Content eq $value} @current;
+ $changes++;
my ($ok, $msg) = $asset->AddCustomFieldValue(
Field => $cfmap{$cfname}->id,
Value => $value,
@@ -139,6 +141,7 @@ sub run {
RT->Logger->error("Failed to set CF $cfname to $value for row $i: $msg");
}
} elsif ($asset->$field ne $value) {
+ $changes++;
my $method = "Set" . $field;
my ($ok, $msg) = $asset->$method( $value );
unless ($ok) {
@@ -146,7 +149,11 @@ sub run {
}
}
}
- $updated++;
+ if ($changes) {
+ $updated++;
+ } else {
+ $skipped++;
+ }
} else {
my $asset = RT::Asset->new( $args{CurrentUser} );
my %args;
commit 7ba643bda75cadb5c4f42df55a0a9ba081450565
Author: Thomas Sibley <trs at bestpractical.com>
Date: Thu Jan 10 17:01:52 2013 -0800
Add Catalog as a valid asset column
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index d55c1de..6d3f591 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -53,7 +53,7 @@ sub run {
"Missing custom field $cfname for column $field2csv->{$fieldname}, skipping");
delete $field2csv->{$fieldname};
}
- } elsif ($fieldname !~ /^(Name|Status|Description|Created|LastUpdated|Owner)$/) {
+ } elsif ($fieldname !~ /^(Name|Status|Description|Catalog|Created|LastUpdated|Owner)$/) {
RT->Logger->warning(
"Unknown asset field $fieldname for column $field2csv->{$fieldname}, skipping");
delete $field2csv->{$fieldname};
commit ea0eee538d5ba774b50edd0ed826e6453ede1687
Author: Thomas Sibley <trs at bestpractical.com>
Date: Thu Jan 10 17:02:03 2013 -0800
Use the correct asset CF lookup type
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 6d3f591..544a881 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -26,7 +26,7 @@ sub run {
my $unique_cf = RT::CustomField->new( $args{CurrentUser} );
$unique_cf->LoadByCols(
Name => $unique,
- LookupType => 'RT::Asset',
+ LookupType => RT::Asset->CustomFieldLookupType,
);
unless ($unique_cf->id) {
RT->Logger->error( "Can't find custom field $unique for RT::Assets" );
@@ -44,7 +44,7 @@ sub run {
my $cf = RT::CustomField->new( $args{CurrentUser} );
$cf->LoadByCols(
Name => $cfname,
- LookupType => 'RT::Asset',
+ LookupType => RT::Asset->CustomFieldLookupType,
);
if ( $cf->id ) {
$cfmap{$cfname} = $cf;
commit 4667bb9848b53258de74a4ad73b14b9686fba566
Author: Thomas Sibley <trs at bestpractical.com>
Date: Thu Jan 10 17:02:06 2013 -0800
Support static values in the RT to CSV field mapping
Static values are indicated by mapping the RT column to a string ref.
This is primarily useful for setting a Catalog for every record in the
import without modifying the CSV. However, it may also be useful when
the CSV generation is not controlled by the user importing and static
values can eliminate a preprocessing step.
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 544a881..5b2078b 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -6,6 +6,10 @@ use Text::CSV_XS;
our $VERSION = '0.01';
+sub _column {
+ ref($_[0]) ? "static value '${$_[0]}'" : "column $_[0]"
+}
+
sub run {
my $class = shift;
my %args = (
@@ -35,7 +39,8 @@ sub run {
my $field2csv = RT->Config->Get('AssetsImportFieldMapping');
my $csv2fields = {};
- push @{$csv2fields->{ $field2csv->{$_} }}, $_ for keys %{$field2csv};
+ push @{$csv2fields->{ $field2csv->{$_} }}, $_
+ for grep { not ref $field2csv->{$_} } keys %{$field2csv};
my %cfmap;
for my $fieldname (keys %{ $field2csv }) {
@@ -50,12 +55,12 @@ sub run {
$cfmap{$cfname} = $cf;
} else {
RT->Logger->warning(
- "Missing custom field $cfname for column $field2csv->{$fieldname}, skipping");
+ "Missing custom field $cfname for "._column($field2csv->{$fieldname}).", skipping");
delete $field2csv->{$fieldname};
}
} elsif ($fieldname !~ /^(Name|Status|Description|Catalog|Created|LastUpdated|Owner)$/) {
RT->Logger->warning(
- "Unknown asset field $fieldname for column $field2csv->{$fieldname}, skipping");
+ "Unknown asset field $fieldname for "._column($field2csv->{$fieldname}).", skipping");
delete $field2csv->{$fieldname};
}
}
@@ -114,7 +119,9 @@ sub run {
my $asset = $assets->First;
my $changes;
for my $field ( keys %$field2csv ) {
- my $value = $item->{$field2csv->{$field}};
+ my $value = ref($field2csv->{$field})
+ ? ${$field2csv->{$field}}
+ : $item->{$field2csv->{$field}};
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
@@ -159,7 +166,9 @@ sub run {
my %args;
for my $field (keys %$field2csv ) {
- my $value = $item->{$field2csv->{$field}};
+ my $value = ref($field2csv->{$field})
+ ? ${$field2csv->{$field}}
+ : $item->{$field2csv->{$field}};
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
@@ -253,6 +262,23 @@ Configure imported fields:
'Serial #' => 'serialNo',
);
+If you want to set an RT column or custom field to a static value for all
+imported assets, proceed the "CSV field name" (right hand side of the mapping)
+with a slash, like so:
+
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ 'Catalog' => \'Hardware',
+ );
+
+Every imported asset will now be added to the Hardware catalog in RT. This
+feature is particularly useful for setting the asset catalog, but may also be
+useful when importing assets from CSV sources you don't control (and don't want
+to modify each time).
+
=back
=head1 AUTHOR
commit 83b6d4d4c9ed5be1512d97df28471534630f171c
Merge: 111f3c1 4667bb9
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Mon Jan 14 23:49:41 2013 -0500
Merge branch 'catalog'
commit b533eef423cc7730ca9da6c5ce836f7e8c81cd8b
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jan 17 17:55:56 2013 -0500
Respect install location
diff --git a/Makefile.PL b/Makefile.PL
index f00f35f..48ceb4e 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,6 +6,16 @@ all_from 'lib/RT/Extension/Assets/Import/CSV.pm';
readme_from 'lib/RT/Extension/Assets/Import/CSV.pm';
license 'gplv2';
+# XXX: This should be reported by M::I::RTx
+my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
+my $local_lib_path = "$RT::LocalPath/lib";
+unshift @INC, $local_lib_path, $lib_path;
+substitute( {
+ RT_LIB_PATH => join( ' ', $local_lib_path, $lib_path ),
+ },
+ 'bin/rt-assets-import-csv',
+);
+
requires 'RT::Extension::Assets';
requires 'Text::CSV_XS';
diff --git a/bin/rt-assets-import-csv b/bin/rt-assets-import-csv
index 5b8b50a..188a58f 100755
--- a/bin/rt-assets-import-csv
+++ b/bin/rt-assets-import-csv
@@ -2,7 +2,8 @@
use strict;
use warnings;
-use lib '/opt/rt4/local/lib', '/opt/rt4/lib';
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
use Getopt::Long;
my %opt;
commit 61b979ed9904485c03c73b151f6864de5415fa39
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Jan 17 17:56:05 2013 -0500
Update README from lib
diff --git a/README b/README
index a572f94..63e7810 100644
--- a/README
+++ b/README
@@ -34,6 +34,23 @@ INSTALLATION
'Serial #' => 'serialNo',
);
+ If you want to set an RT column or custom field to a static value
+ for all imported assets, proceed the "CSV field name" (right hand
+ side of the mapping) with a slash, like so:
+
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ 'Catalog' => \'Hardware',
+ );
+
+ Every imported asset will now be added to the Hardware catalog in
+ RT. This feature is particularly useful for setting the asset
+ catalog, but may also be useful when importing assets from CSV
+ sources you don't control (and don't want to modify each time).
+
AUTHOR
sunnavy <sunnavy at bestpractical.com>
commit 9365a5c0468f1ba0a59c8fcabdcc524616deab24
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Jan 18 05:49:42 2013 -0500
Substitute perl path, and switch to a .in file
diff --git a/.gitignore b/.gitignore
index 8eb2c58..91624c1 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,3 +11,4 @@ pod2htm*.tmp
*.swp
/MYMETA.*
/xt/tmp/
+/bin/rt-assets-import-csv
diff --git a/Makefile.PL b/Makefile.PL
index 48ceb4e..ecbfa78 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,13 +6,16 @@ all_from 'lib/RT/Extension/Assets/Import/CSV.pm';
readme_from 'lib/RT/Extension/Assets/Import/CSV.pm';
license 'gplv2';
-# XXX: This should be reported by M::I::RTx
-my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
-my $local_lib_path = "$RT::LocalPath/lib";
-unshift @INC, $local_lib_path, $lib_path;
+use Config;
+my $perl_path = $Config{perlpath};
+$perl_path .= $Config{_exe}
+ if $^O ne 'VMS' and $perl_path !~ m/$Config{_exe}$/i;
+
substitute( {
- RT_LIB_PATH => join( ' ', $local_lib_path, $lib_path ),
+ RT_LIB_PATH => "$RT::LocalPath/lib " . File::Basename::dirname( $INC{'RT.pm'} ),
+ PERL => $perl_path,
},
+ { sufix => ".in" },
'bin/rt-assets-import-csv',
);
diff --git a/bin/rt-assets-import-csv b/bin/rt-assets-import-csv.in
similarity index 98%
rename from bin/rt-assets-import-csv
rename to bin/rt-assets-import-csv.in
index 188a58f..4baa3f7 100755
--- a/bin/rt-assets-import-csv
+++ b/bin/rt-assets-import-csv.in
@@ -1,4 +1,6 @@
#!/usr/bin/env perl
+### before: #!@PERL@
+
use strict;
use warnings;
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;
+
commit 9748de028419b471c6f35999958ad8f05a4f54c5
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 12 17:39:59 2013 -0500
Document existing options
diff --git a/bin/rt-assets-import-csv.in b/bin/rt-assets-import-csv.in
index 4baa3f7..22fc180 100755
--- a/bin/rt-assets-import-csv.in
+++ b/bin/rt-assets-import-csv.in
@@ -61,4 +61,21 @@ rt-assets-import - import assets to rt
=head1 DESCRIPTION
-This script will import/update assets in csv to rt
+This script will import/update assets from a CSV into rt. See
+L<RT::Extension::Assets::Import::CSV> for configuration.
+
+=head1 OPTIONS
+
+=over
+
+=item C<--update>
+
+Without this option, existing assets (as determined by matching
+C<AssetsImportUniqueCF> values) are left untouched. With this option
+provided, records will be updated based on their values in the CSV.
+
+=item C<--debug>
+
+Provide verbose output to STDERR during the import.
+
+=back
commit eac05d2d00a9459dc3852880415cfcedf3296a5a
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 12 17:42:02 2013 -0500
Provide options to explicitly set date format of the imported file
While simply setting DateDayBeforeMonth in RT_SiteConfig.pm is a
solution, it is entirely possible that different CSV files may have
different date orderings; hence, provide a command-line override.
diff --git a/bin/rt-assets-import-csv.in b/bin/rt-assets-import-csv.in
index 22fc180..686156c 100755
--- a/bin/rt-assets-import-csv.in
+++ b/bin/rt-assets-import-csv.in
@@ -9,7 +9,7 @@ use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
use Getopt::Long;
my %opt;
-GetOptions( \%opt, 'help|h', 'update|u', 'debug|d' );
+GetOptions( \%opt, 'help|h', 'update|u', 'debug|d', 'mdy', 'dmy' );
my $file = shift @ARGV;
if ( $opt{help} || !$file ) {
@@ -18,6 +18,11 @@ if ( $opt{help} || !$file ) {
exit;
}
+if ($opt{mdy} and $opt{dmy}) {
+ Pod::Usage::pod2usage("Only one of --mdy or --dmy can be provided");
+ exit;
+}
+
use RT;
use RT::Interface::CLI qw(CleanEnv GetCurrentUser);
@@ -25,6 +30,8 @@ CleanEnv();
RT->LoadConfig();
RT->Config->Set( LogToSTDERR => $opt{debug} ? 'debug' : 'warning' );
+RT->Config->Set( DateDayBeforeMonth => 1 ) if $opt{dmy};
+RT->Config->Set( DateDayBeforeMonth => 0 ) if $opt{mdy};
RT->Init();
require RT::Extension::Assets::Import::CSV;
@@ -74,6 +81,12 @@ Without this option, existing assets (as determined by matching
C<AssetsImportUniqueCF> values) are left untouched. With this option
provided, records will be updated based on their values in the CSV.
+=item C<--mdy>, C<--dmy>
+
+Force RT to parse dates as C<mm/dd/yy> or C<dd/mm/yy>, respectively. In
+the absence of this option, RT will default to the C<DateDayBeforeMonth>
+setting, which defaults to C<dd/mm/yy>.
+
=item C<--debug>
Provide verbose output to STDERR during the import.
commit dfa4b3be5af6f51357a63b26cdf7aa6cfc96a27c
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 26 15:35:31 2013 -0500
Update Module::Install::RTx
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index ce01018..abf6aea 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -14,7 +14,7 @@ use FindBin;
use File::Glob ();
use File::Basename ();
-my @DIRS = qw(etc lib html bin sbin po var);
+my @DIRS = qw(etc lib html static bin sbin po var);
my @INDEX_DIRS = qw(lib bin sbin);
sub RTx {
@@ -62,10 +62,11 @@ sub RTx {
unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
unshift @INC, $lib_path;
- $RT::LocalVarPath ||= $RT::VarPath;
- $RT::LocalPoPath ||= $RT::LocalLexiconPath;
- $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
- $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalStaticPath ||= $RT::StaticPath;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
my $with_subdirs = $ENV{WITH_SUBDIRS};
@ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
@@ -208,4 +209,4 @@ sub requires_rt {
__END__
-#line 328
+#line 329
commit fe2c1f04b15731ddc3049a9421d36204f37c1005
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 26 23:52:43 2013 -0500
Allow more complicated loading of data via subrefs
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 5b2078b..e96653e 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -7,7 +7,10 @@ use Text::CSV_XS;
our $VERSION = '0.01';
sub _column {
- ref($_[0]) ? "static value '${$_[0]}'" : "column $_[0]"
+ ref($_[0]) ? (ref($_[0]) eq "CODE" ?
+ "code reference" :
+ "static value '${$_[0]}'")
+ : "column $_[0]"
}
sub run {
@@ -94,7 +97,7 @@ sub run {
}
my $assets = RT::Assets->new( $args{CurrentUser} );
- my $id_value = $item->{$field2csv->{"CF.$unique"}};
+ my $id_value = $class->get_value( $field2csv->{"CF.$unique"}, $item );
$assets->LimitCustomField(
CUSTOMFIELD => $unique_cf->id,
VALUE => $id_value,
@@ -119,9 +122,7 @@ sub run {
my $asset = $assets->First;
my $changes;
for my $field ( keys %$field2csv ) {
- my $value = ref($field2csv->{$field})
- ? ${$field2csv->{$field}}
- : $item->{$field2csv->{$field}};
+ my $value = $class->get_value( $field2csv->{$field}, $item );
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
@@ -166,9 +167,7 @@ sub run {
my %args;
for my $field (keys %$field2csv ) {
- my $value = ref($field2csv->{$field})
- ? ${$field2csv->{$field}}
- : $item->{$field2csv->{$field}};
+ my $value = $class->get_value($field2csv->{$field}, $item);
next unless defined $value and length $value;
if ($field =~ /^CF\.(.*)/) {
my $cfname = $1;
@@ -191,6 +190,18 @@ sub run {
return ( $created, $updated, $skipped );
}
+sub get_value {
+ my $class = shift;
+ my ($from, $data) = @_;
+ if (not ref $from) {
+ return $data->{$from};
+ } elsif (ref($from) eq "CODE") {
+ return $from->($data);
+ } else {
+ return $$from;
+ }
+}
+
sub parse_csv {
my $class = shift;
my $file = shift;
commit cc8a8dae16c4696fa93ac771f1864391d8b414f9
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 26 23:53:25 2013 -0500
Support user role groups
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index e96653e..c38bc08 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -61,7 +61,14 @@ sub run {
"Missing custom field $cfname for "._column($field2csv->{$fieldname}).", skipping");
delete $field2csv->{$fieldname};
}
- } elsif ($fieldname !~ /^(Name|Status|Description|Catalog|Created|LastUpdated|Owner)$/) {
+ } elsif ($fieldname =~ /^(Name|Status|Description|Catalog|Created|LastUpdated)$/) {
+ # no-op, these are fine
+ } elsif ( RT::Asset->HasRole($fieldname) ) {
+ if ( not RT::Asset->Role($fieldname)->{Single}) {
+ RT->Logger->warning( "Role name $fieldname must be single-value for "._column($field2csv->{$fieldname}).", skipping");
+ delete $field2csv->{$fieldname};
+ }
+ } else {
RT->Logger->warning(
"Unknown asset field $fieldname for "._column($field2csv->{$fieldname}).", skipping");
delete $field2csv->{$fieldname};
@@ -148,6 +155,17 @@ sub run {
unless ($ok) {
RT->Logger->error("Failed to set CF $cfname to $value for row $i: $msg");
}
+ } elsif ($asset->HasRole($field)) {
+ my $user = RT::User->new( $args{CurrentUser} );
+ $user->Load( $value );
+ $user = RT->Nobody unless $user->id;
+ next if $asset->RoleGroup($field)->HasMember( $user->PrincipalId );
+
+ $changes++;
+ my ($ok, $msg) = $asset->AddRoleMember( PrincipalId => $user->PrincipalId );
+ unless ($ok) {
+ RT->Logger->error("Failed to set $field to $value for row $i: $msg");
+ }
} elsif ($asset->$field ne $value) {
$changes++;
my $method = "Set" . $field;
commit b1d17c9036cb118a7d2d681c3917e6180b5109ae
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Feb 26 23:53:39 2013 -0500
Fix a typo in an error message
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index c38bc08..95019ae 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -171,7 +171,7 @@ sub run {
my $method = "Set" . $field;
my ($ok, $msg) = $asset->$method( $value );
unless ($ok) {
- RT->Logger->error("Failed to set $field to $value for row $1: $msg");
+ RT->Logger->error("Failed to set $field to $value for row $i: $msg");
}
}
}
commit 126404ea7d8fd51ef9f86fd32f0bc835765ca052
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Feb 27 15:15:53 2013 -0500
atch that SetCatalog doesn't round-trip, given a string
This led to "Failed to set Catalog to Hardware for row 17: Catalog is
already set to Hardware" errors.
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 95019ae..99612e3 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -166,12 +166,20 @@ sub run {
unless ($ok) {
RT->Logger->error("Failed to set $field to $value for row $i: $msg");
}
- } elsif ($asset->$field ne $value) {
- $changes++;
- my $method = "Set" . $field;
- my ($ok, $msg) = $asset->$method( $value );
- unless ($ok) {
- RT->Logger->error("Failed to set $field to $value for row $i: $msg");
+ } else {
+ if ($field eq "Catalog") {
+ my $catalog = RT::Catalog->new( $args{CurrentUser} );
+ $catalog->Load( $value );
+ $value = $catalog->id;
+ }
+
+ if ($asset->$field ne $value) {
+ $changes++;
+ my $method = "Set" . $field;
+ my ($ok, $msg) = $asset->$method( $value );
+ unless ($ok) {
+ RT->Logger->error("Failed to set $field to $value for row $i: $msg");
+ }
}
}
}
commit 219b6229479a9b882a9f573e93f97df9597bef2d
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Mar 28 19:29:16 2013 -0400
Remove the unnecessary and wrong "make initdb" step in the docs
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 99612e3..4264a2c 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -271,16 +271,6 @@ RT-Extension-Assets-Import-CSV - RT Assets Import from CSV
May need root permissions
-=item make initdb
-
-Only run this the first time you install this module.
-
-If you run this twice, you may end up with duplicate data
-in your database.
-
-If you are upgrading this module, check for upgrading instructions
-in case changes need to be made to your database.
-
=item Edit your /opt/rt4/etc/RT_SiteConfig.pm
Add this line:
commit 9b1e8a4b05b195bfa4b80cc823095527ef4d61c6
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Mar 28 19:32:30 2013 -0400
Move CONFIGURATION out, allowing it to gain more sub-headings
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 4264a2c..e56ef51 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -277,9 +277,18 @@ Add this line:
Set(@Plugins, qw(RT::Extension::Assets::Import::CSV));
-or add C<RT::Extension::Assets::Import::CSV> to your existing C<@Plugins> line.
+or add C<RT::Extension::Assets::Import::CSV> to your existing
+C<@Plugins> line.
-Configure imported fields:
+See L</CONFIGURATION>, below, for the remainder of the required
+configuration.
+
+=back
+
+=head1 CONFIGURATION
+
+The following configuration would be used to import a three-column CSV
+of assets, where the column titled C<serviceTag> is unique:
Set( $AssetsImportUniqueCF, 'Service Tag' );
Set( %AssetsImportFieldMapping,
@@ -289,10 +298,13 @@ Configure imported fields:
'Serial #' => 'serialNo',
);
-If you want to set an RT column or custom field to a static value for all
-imported assets, proceed the "CSV field name" (right hand side of the mapping)
-with a slash, like so:
+=head2 Constant values
+If you want to set an RT column or custom field to a static value for
+all imported assets, proceed the "CSV field name" (right hand side of
+the mapping) with a slash, like so:
+
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
Set( %AssetsImportFieldMapping,
# 'RT custom field name' => 'CSV field name'
'Service Tag' => 'serviceTag',
@@ -301,12 +313,11 @@ with a slash, like so:
'Catalog' => \'Hardware',
);
-Every imported asset will now be added to the Hardware catalog in RT. This
-feature is particularly useful for setting the asset catalog, but may also be
-useful when importing assets from CSV sources you don't control (and don't want
-to modify each time).
+Every imported asset will now be added to the Hardware catalog in RT.
+This feature is particularly useful for setting the asset catalog, but
+may also be useful when importing assets from CSV sources you don't
+control (and don't want to modify each time).
-=back
=head1 AUTHOR
commit 63b10b34b7bbd1e5921cca9ba7c5b7ecb08d93aa
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Mar 28 19:33:30 2013 -0400
Document the ability to have computed values
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index e56ef51..1d0c54f 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -318,6 +318,19 @@ This feature is particularly useful for setting the asset catalog, but
may also be useful when importing assets from CSV sources you don't
control (and don't want to modify each time).
+=head2 Computed values
+
+You may also compute values during import, by passing a subroutine
+reference as the value in the C<%AssetsImportFieldMapping>. This
+subroutine will be called with a hash reference of the parsed CSV row.
+
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Weight' => sub { $_[0]->{"Weight (kg)"} || "(unknown)" },
+ );
=head1 AUTHOR
commit e60c72a5f1fefe1c0f1be03967c133b149e9ef87
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu Mar 28 19:34:23 2013 -0400
Allow importing with a numeric unique column used for asset ids
This allows RT to take ownership of an pre-existing serial number during
import. While it requires that such an import only happen once (upon
which RT becomes blessed as the generator of all future asset IDs), it
allows RT's pervasive concept of "asset number" to line up with users'
pre-existing concepts of such when moving from an existing system.
After importing, the sequences must be updated soas to not overlap with
existing ids. This is unnecessary on mysql and SQLite, as they adjust
their auto_increment values upon seeing the insert, but requires
explicit steps on PostgreSQL and Oracle.
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 1d0c54f..6962629 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -23,21 +23,17 @@ sub run {
);
my $unique = RT->Config->Get('AssetsImportUniqueCF');
- unless ($unique) {
- RT->Logger->error(
- 'Missing identified field, please set config AssetsImportUniqueCF'
+ my $unique_cf;
+ if ($unique) {
+ $unique_cf = RT::CustomField->new( $args{CurrentUser} );
+ $unique_cf->LoadByCols(
+ Name => $unique,
+ LookupType => RT::Asset->CustomFieldLookupType,
);
- return (0,0,0);
- }
-
- my $unique_cf = RT::CustomField->new( $args{CurrentUser} );
- $unique_cf->LoadByCols(
- Name => $unique,
- LookupType => RT::Asset->CustomFieldLookupType,
- );
- unless ($unique_cf->id) {
- RT->Logger->error( "Can't find custom field $unique for RT::Assets" );
- return (0, 0, 0);
+ unless ($unique_cf->id) {
+ RT->Logger->error( "Can't find custom field $unique for RT::Assets" );
+ return (0, 0, 0);
+ }
}
my $field2csv = RT->Config->Get('AssetsImportFieldMapping');
@@ -61,7 +57,7 @@ sub run {
"Missing custom field $cfname for "._column($field2csv->{$fieldname}).", skipping");
delete $field2csv->{$fieldname};
}
- } elsif ($fieldname =~ /^(Name|Status|Description|Catalog|Created|LastUpdated)$/) {
+ } elsif ($fieldname =~ /^(id|Name|Status|Description|Catalog|Created|LastUpdated)$/) {
# no-op, these are fine
} elsif ( RT::Asset->HasRole($fieldname) ) {
if ( not RT::Asset->Role($fieldname)->{Single}) {
@@ -75,7 +71,12 @@ sub run {
}
}
- my @required_columns = ( $field2csv->{"CF.$unique"} );
+ if (not $unique and not $field2csv->{"id"}) {
+ RT->Logger->warning("No column set for 'id'; is AssetsImportUniqueCF intentionally unset?");
+ return (0, 0, 0);
+ }
+
+ my @required_columns = ( $field2csv->{$unique ? "CF.$unique" : "id"} );
my @items = $class->parse_csv( $args{File} );
unless (@items) {
@@ -104,16 +105,20 @@ sub run {
}
my $assets = RT::Assets->new( $args{CurrentUser} );
- my $id_value = $class->get_value( $field2csv->{"CF.$unique"}, $item );
- $assets->LimitCustomField(
- CUSTOMFIELD => $unique_cf->id,
- VALUE => $id_value,
- );
+ my $id_value = $class->get_value( $field2csv->{$unique ? "CF.$unique" : "id"}, $item );
+ if ($unique) {
+ $assets->LimitCustomField(
+ CUSTOMFIELD => $unique_cf->id,
+ VALUE => $id_value,
+ );
+ } else {
+ $assets->Limit( FIELD => "id", VALUE => $id_value );
+ }
if ( $assets->Count ) {
if ( $assets->Count > 1 ) {
RT->Logger->warning(
- "Found multiple assets for $unique = $id_value"
+ "Found multiple assets for @{[$unique||'id']} = $id_value"
);
$skipped++;
next;
@@ -213,6 +218,26 @@ sub run {
}
}
}
+
+ unless ($unique) {
+ # Update Asset sequence; mysql and SQLite do this implicitly
+ my $dbtype = RT->Config->Get('DatabaseType');
+ my $dbh = RT->DatabaseHandle->dbh;
+ if ( $dbtype eq "Pg" ) {
+ $dbh->do("SELECT setval('rtxassets_id_seq', (SELECT MAX(id) FROM RTxAssets))");
+ } elsif ( $dbtype eq "Oracle" ) {
+ my ($max) = $dbh->selectrow_array("SELECT MAX(id) FROM RTxAssets");
+ my ($cur) = $dbh->selectrow_array("SELECT RTxAssets_seq.nextval FROM dual");
+ if ($max > $cur) {
+ $dbh->do("ALTER SEQUENCE RTxAssets_seq INCREMENT BY ". ($max - $cur));
+ # The next command _must_ be a select, and not a ->do,
+ # or Oracle doesn't actually fetch from the sequence.
+ $dbh->selectrow_array("SELECT RTxAssets_seq.nextval FROM dual");
+ $dbh->do("ALTER SEQUENCE RTxAssets_seq INCREMENT BY 1");
+ }
+ }
+ }
+
return ( $created, $updated, $skipped );
}
@@ -332,6 +357,23 @@ subroutine will be called with a hash reference of the parsed CSV row.
'Weight' => sub { $_[0]->{"Weight (kg)"} || "(unknown)" },
);
+=head2 Numeric identifiers
+
+If you are already using a numeric identifier to uniquely track your
+assets, and wish RT to take over handling of that identifier, you can
+choose to leave C<$AssetsImportUniqueCF> unset, and assign to C<id> in
+the C<%AssetsImportFieldMapping>:
+
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'id' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ );
+
+This requires that, after the import, RT becomes the generator of all
+asset ids. Otherwise, asset id conflicts may occur.
+
=head1 AUTHOR
sunnavy <sunnavy at bestpractical.com>
commit f26f7b47a2a9c2220838fc7733ee5a5c980d12c1
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Fri Mar 29 22:14:02 2013 -0400
Update README from updated POD
diff --git a/README b/README
index 63e7810..b0c9f86 100644
--- a/README
+++ b/README
@@ -7,15 +7,6 @@ INSTALLATION
make install
May need root permissions
- make initdb
- Only run this the first time you install this module.
-
- If you run this twice, you may end up with duplicate data in your
- database.
-
- If you are upgrading this module, check for upgrading instructions
- in case changes need to be made to your database.
-
Edit your /opt/rt4/etc/RT_SiteConfig.pm
Add this line:
@@ -24,32 +15,68 @@ INSTALLATION
or add "RT::Extension::Assets::Import::CSV" to your existing
@Plugins line.
- Configure imported fields:
-
- Set( $AssetsImportUniqueCF, 'Service Tag' );
- Set( %AssetsImportFieldMapping,
- # 'RT custom field name' => 'CSV field name'
- 'Service Tag' => 'serviceTag',
- 'Location' => 'building',
- 'Serial #' => 'serialNo',
- );
-
- If you want to set an RT column or custom field to a static value
- for all imported assets, proceed the "CSV field name" (right hand
- side of the mapping) with a slash, like so:
-
- Set( %AssetsImportFieldMapping,
- # 'RT custom field name' => 'CSV field name'
- 'Service Tag' => 'serviceTag',
- 'Location' => 'building',
- 'Serial #' => 'serialNo',
- 'Catalog' => \'Hardware',
- );
-
- Every imported asset will now be added to the Hardware catalog in
- RT. This feature is particularly useful for setting the asset
- catalog, but may also be useful when importing assets from CSV
- sources you don't control (and don't want to modify each time).
+ See "CONFIGURATION", below, for the remainder of the required
+ configuration.
+
+CONFIGURATION
+ The following configuration would be used to import a three-column CSV
+ of assets, where the column titled "serviceTag" is unique:
+
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ );
+
+ Constant values
+ If you want to set an RT column or custom field to a static value for
+ all imported assets, proceed the "CSV field name" (right hand side of
+ the mapping) with a slash, like so:
+
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ 'Catalog' => \'Hardware',
+ );
+
+ Every imported asset will now be added to the Hardware catalog in RT.
+ This feature is particularly useful for setting the asset catalog, but
+ may also be useful when importing assets from CSV sources you don't
+ control (and don't want to modify each time).
+
+ Computed values
+ You may also compute values during import, by passing a subroutine
+ reference as the value in the %AssetsImportFieldMapping. This subroutine
+ will be called with a hash reference of the parsed CSV row.
+
+ Set( $AssetsImportUniqueCF, 'Service Tag' );
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'Service Tag' => 'serviceTag',
+ 'Location' => 'building',
+ 'Weight' => sub { $_[0]->{"Weight (kg)"} || "(unknown)" },
+ );
+
+ Numeric identifiers
+ If you are already using a numeric identifier to uniquely track your
+ assets, and wish RT to take over handling of that identifier, you can
+ choose to leave $AssetsImportUniqueCF unset, and assign to "id" in the
+ %AssetsImportFieldMapping:
+
+ Set( %AssetsImportFieldMapping,
+ # 'RT custom field name' => 'CSV field name'
+ 'id' => 'serviceTag',
+ 'Location' => 'building',
+ 'Serial #' => 'serialNo',
+ );
+
+ This requires that, after the import, RT becomes the generator of all
+ asset ids. Otherwise, asset id conflicts may occur.
AUTHOR
sunnavy <sunnavy at bestpractical.com>
commit 00b48267682c98fc1c0b33c0df9bab336e6aec6a
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Thu May 30 23:53:36 2013 -0400
Allow inserting records which no provide no id (after all those that do)
diff --git a/bin/rt-assets-import-csv.in b/bin/rt-assets-import-csv.in
index 686156c..ddf9ccb 100755
--- a/bin/rt-assets-import-csv.in
+++ b/bin/rt-assets-import-csv.in
@@ -9,7 +9,7 @@ use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
use Getopt::Long;
my %opt;
-GetOptions( \%opt, 'help|h', 'update|u', 'debug|d', 'mdy', 'dmy' );
+GetOptions( \%opt, 'help|h', 'update|u', 'insert|i', 'debug|d', 'mdy', 'dmy' );
my $file = shift @ARGV;
if ( $opt{help} || !$file ) {
@@ -47,6 +47,7 @@ my ( $created, $updated, $skipped ) = RT::Extension::Assets::Import::CSV->run(
CurrentUser => $current_user,
File => $file,
Update => $opt{update},
+ Insert => $opt{insert},
);
print <<"EOF";
@@ -81,6 +82,12 @@ Without this option, existing assets (as determined by matching
C<AssetsImportUniqueCF> values) are left untouched. With this option
provided, records will be updated based on their values in the CSV.
+=item C<--insert>
+
+By default, assets without a C<AssetsImportUniqueCF> values will produce
+a warning; with this flag, they will be inserted (generating their own
+id as needed) after all other operations.
+
=item C<--mdy>, C<--dmy>
Force RT to parse dates as C<mm/dd/yy> or C<dd/mm/yy>, respectively. In
diff --git a/lib/RT/Extension/Assets/Import/CSV.pm b/lib/RT/Extension/Assets/Import/CSV.pm
index 6962629..1e177d9 100644
--- a/lib/RT/Extension/Assets/Import/CSV.pm
+++ b/lib/RT/Extension/Assets/Import/CSV.pm
@@ -19,6 +19,7 @@ sub run {
CurrentUser => undef,
File => undef,
Update => undef,
+ Insert => undef,
@_,
);
@@ -92,15 +93,21 @@ sub run {
RT->Logger->debug( 'Found ' . scalar(@items) . ' record(s)' );
my ( $created, $updated, $skipped ) = (0) x 3;
my $i = 1; # Because of header row
+ my @later;
for my $item (@items) {
$i++;
next unless grep {/\S/} values %{$item};
my @missing = grep {not $item->{$_}} @required_columns;
if (@missing) {
- RT->Logger->warning(
- "Missing value for required column@{[@missing > 1 ? 's':'']} @missing at row $i, skipping");
- $skipped++;
+ if ($args{Insert}) {
+ $item->{''} = $i;
+ push @later, $item;
+ } else {
+ RT->Logger->warning(
+ "Missing value for required column@{[@missing > 1 ? 's':'']} @missing at row $i, skipping");
+ $skipped++;
+ }
next;
}
@@ -238,6 +245,32 @@ sub run {
}
}
+ for my $item (@later) {
+ my $row = delete $item->{''};
+ my $asset = RT::Asset->new( $args{CurrentUser} );
+ my %args;
+
+ for my $field (keys %$field2csv ) {
+ my $value = $class->get_value($field2csv->{$field}, $item);
+ next unless defined $value and length $value;
+ if ($field =~ /^CF\.(.*)/) {
+ my $cfname = $1;
+ $args{"CustomField-".$cfmap{$cfname}->id} = $value;
+ } else {
+ $args{$field} = $value;
+ }
+ }
+
+ my ($ok, $msg, $err) = $asset->Create( %args );
+ if ($ok) {
+ $created++;
+ } elsif ($err and @{$err}) {
+ RT->Logger->warning(join("\n", "Warnings during create for row $row: ", @{$err}) );
+ } else {
+ RT->Logger->error("Failed to create asset for row $row: $msg");
+ }
+ }
+
return ( $created, $updated, $skipped );
}
commit ffd2d4b4f696000fb14f2ecbc8b38e14c40c1edd
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Mon Aug 5 20:50:03 2013 -0400
Bump Module::Install::RTx
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index abf6aea..c9fe996 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.30';
+our $VERSION = '0.31';
use FindBin;
use File::Glob ();
commit a449381ac75c84b03254cc1433794a7e6152afb8
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Tue Sep 24 14:20:49 2013 -0400
Update inc/
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index c9fe996..ac04c79 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.31';
+our $VERSION = '0.32';
use FindBin;
use File::Glob ();
@@ -136,6 +136,7 @@ install ::
$has_etc{acl}++;
}
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+ if ( -d 'etc/upgrade/' ) { $has_etc{upgrade}++; }
$self->postamble("$postamble\n");
unless ( $subdirs{'lib'} ) {
@@ -164,6 +165,12 @@ install ::
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
+ if ($has_etc{upgrade}) {
+ print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
+ my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+ $self->postamble("upgrade-database ::\n$upgradedb\n");
+ $self->postamble("upgradedb ::\n$upgradedb\n");
+ }
}
}
@@ -209,4 +216,4 @@ sub requires_rt {
__END__
-#line 329
+#line 336
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index 6a80818..b5e03c3 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,7 +7,7 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.20';
+$VERSION = '0.22';
sub readme_from {
my $self = shift;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list