[Bps-public-commit] RT-Extension-ACNS branch, master, updated. 0.01-9-gaa099bf
Alex Vandiver
alexmv at bestpractical.com
Wed Jun 11 10:08:01 EDT 2014
The branch, master has been updated
via aa099bf09330c1223e18d8b5c4dfeb6bb0c8f5a9 (commit)
via d4b6427bd5d7e90924a262363c7ffbb6b956b013 (commit)
via 3806fd22c9dd03dabb986f29adbd06ece375027b (commit)
via 93e8a6b2bb8718c2fe24e33b0554fefb39a6a02d (commit)
via 305e62bf27a6a73d2afd7264d6fbee9bb9739776 (commit)
via 7dfcf3ea8762f67f179ba960a089ab07ab7e916e (commit)
via e4cd0133e7c61ee9e1f019196c763654604f25cb (commit)
via 3b58b8742f32c1a34baf62943be854ea80ec26a1 (commit)
via 77f8d1431a7489adb62ccd21572f45f17d174b0c (commit)
from d0de2491a49731c1e0cc8965d4454446bdc52713 (commit)
Summary of changes:
.gitignore | 2 +
Changes | 12 +
MANIFEST | 5 +-
META.yml | 9 +-
etc/RT_ACNSConfig.pm | 23 +-
inc/Module/Install.pm | 6 +-
inc/Module/Install/Base.pm | 2 +-
inc/Module/Install/Can.pm | 85 ++++++-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Makefile.pm | 27 ++-
inc/Module/Install/Metadata.pm | 29 ++-
inc/Module/Install/RTx.pm | 69 ++++--
inc/Module/Install/RTx/Factory.pm | 449 +-----------------------------------
inc/Module/Install/ReadmeFromPod.pm | 112 ++++++++-
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 2 +-
lib/RT/Action/ParseACNS.pm | 48 +++-
lib/RT/Condition/ACNSMessage.pm | 11 +-
lib/RT/Extension/ACNS.pm | 2 +-
lib/RT/Extension/ACNS/Test.pm | 2 +-
t/callbacks.t | 49 ++++
t/data/sample1.eml | 68 ++++++
t/data/sample2.eml | 59 +++++
t/samples.t | 34 +++
24 files changed, 573 insertions(+), 536 deletions(-)
create mode 100644 t/callbacks.t
create mode 100644 t/data/sample1.eml
create mode 100644 t/data/sample2.eml
create mode 100644 t/samples.t
- Log -----------------------------------------------------------------
commit 77f8d1431a7489adb62ccd21572f45f17d174b0c
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Mar 26 16:14:38 2013 +0400
handle acns xml in an attachment
diff --git a/lib/RT/Action/ParseACNS.pm b/lib/RT/Action/ParseACNS.pm
index a933a3e..76899e0 100644
--- a/lib/RT/Action/ParseACNS.pm
+++ b/lib/RT/Action/ParseACNS.pm
@@ -10,13 +10,29 @@ use Parse::ACNS;
sub Prepare {
my $self = shift;
- my $content = $self->TransactionObj->Content;
- $content =~ s/^.*Start ACNS XML\n//s
- or $RT::Logger->warn("No 'Start ACNS XML' marker");
- $content =~ s/- -+End ACNS XML.*$//s
- or $RT::Logger->warn("No 'End ACNS XML' marker");
+ my $xml;
+
+ my $txn = $self->TransactionObj;
+
+ my $content = $txn->Content;
+ if ( $content =~ s/^.*Start ACNS XML\n//s ) {
+ $content =~ s/- -+End ACNS XML.*$//s;
+ $xml = XML::LibXML->new->parse_string( $content );
+ } else {
+ my $attachments = $txn->Attachments;
+ while ( my $attach = $attachments->Next ) {
+ next unless ($attach->Filename||'') =~ /\.xml$/;
+ next unless ($attach->Content||'') =~ /Infringement/i;
+
+ $xml = XML::LibXML->new->parse_string( $attach->Content );
+ last;
+ }
+ }
+ unless ($xml) {
+ $RT::Logger->error("Failed to find ACNS XML");
+ return 1;
+ }
- my $xml = XML::LibXML->new->parse_string( $content );
my $data = Parse::ACNS->new->parse( $xml );
$self->{'ACNS'} = $self->MapDataOverCFs( $data );
return 1;
diff --git a/lib/RT/Condition/ACNSMessage.pm b/lib/RT/Condition/ACNSMessage.pm
index 615ae44..d614cbd 100644
--- a/lib/RT/Condition/ACNSMessage.pm
+++ b/lib/RT/Condition/ACNSMessage.pm
@@ -6,7 +6,16 @@ use base 'RT::Condition';
sub IsApplicable {
my $self = shift;
- return $self->TransactionObj->Content =~ /Start ACNS XML/;
+ my $txn = $self->TransactionObj;
+ return 1 if $txn->Content =~ /Start ACNS XML/;
+
+ my $attachments = $txn->Attachments;
+ while ( my $attach = $attachments->Next ) {
+ next unless ($attach->Filename||'') =~ /\.xml$/;
+ next unless ($attach->Content||'') =~ /Infringement/i;
+ return 1;
+ }
+ return 0;
}
1;
commit 3b58b8742f32c1a34baf62943be854ea80ec26a1
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Mar 26 16:15:07 2013 +0400
update M::I
diff --git a/META.yml b/META.yml
index dfbe233..e0ac7af 100644
--- a/META.yml
+++ b/META.yml
@@ -3,11 +3,12 @@ abstract: 'parse ACNS messages and extract info into custom fields'
author:
- 'Ruslan Zakirov <ruz at bestpractical.com>'
build_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
configure_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
distribution_type: module
-generated_by: 'Module::Install version 1.00'
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 8ee839d..4ecf46b 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
# 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.00';
+ $VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -451,7 +451,7 @@ sub _version ($) {
}
sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
+ _version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
@@ -467,4 +467,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2010 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index b55bda3..802844a 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 71ccc27..22167b8 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -3,13 +3,12 @@ package Module::Install::Can;
use strict;
use Config ();
-use File::Spec ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -29,7 +28,7 @@ sub can_use {
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
-# check if we can run some command
+# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
@@ -38,14 +37,88 @@ sub can_run {
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
-# can we locate a (the) C compiler
+# 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;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 156
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index ec1f106..bee0c4f 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 5dfd0e9..7052f36 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -215,18 +215,22 @@ sub write {
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
- $self->build_requires( 'ExtUtils::MakeMaker' => $v );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+ # 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.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
@@ -241,7 +245,6 @@ in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
- $DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
@@ -412,4 +415,4 @@ sub postamble {
__END__
-#line 541
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index cfe45b3..58430f3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -151,15 +151,21 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ 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} = $_[0] ? 1 : 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 @_;
@@ -170,7 +176,7 @@ sub perl_version {
# Normalize the version
$version = $self->_perl_version($version);
- # We don't support the reall old versions
+ # 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";
}
@@ -515,6 +521,7 @@ sub __extract_license {
'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,
@@ -550,9 +557,9 @@ sub license_from {
sub _extract_bugtracker {
my @links = $_[0] =~ m#L<(
- \Qhttp://rt.cpan.org/\E[^>]+|
- \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
- \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ 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}=();
@@ -581,7 +588,7 @@ sub bugtracker_from {
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 5480124..ce01018 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.25';
+our $VERSION = '0.30';
use FindBin;
use File::Glob ();
@@ -42,10 +42,10 @@ sub RTx {
$INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
} else {
local @INC = (
- @INC,
$ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
- map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
- @prefixes
+ @INC,
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+ } grep $_, @prefixes
);
until ( eval { require RT; $RT::LocalPath } ) {
warn
@@ -60,6 +60,7 @@ sub RTx {
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;
@@ -128,18 +129,7 @@ install ::
my %has_etc;
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
-
- # got schema, load factory module
$has_etc{schema}++;
- $self->load('RTxFactory');
- $self->postamble(<< ".");
-factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
-
-.
}
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
$has_etc{acl}++;
@@ -163,30 +153,59 @@ dropdb ::
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))"
+\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))"
+\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))"
+\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");
}
}
-sub RTxInit {
- unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
- require RT;
- RT::LoadConfig();
- RT::ConnectToDatabase();
+# 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);
- die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+ 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 303
+#line 328
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
index 23ce911..a8702e4 100644
--- a/inc/Module/Install/RTx/Factory.pm
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -6,7 +6,7 @@ use strict;
use File::Basename ();
sub RTxInitDB {
- my ($self, $action) = @_;
+ my ($self, $action, $name, $version) = @_;
unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
@@ -23,6 +23,8 @@ sub RTxInitDB {
RT::LoadConfig();
+ require RT::System;
+
my $lib_path = File::Basename::dirname($INC{'RT.pm'});
my @args = ("-Ilib");
push @args, "-I$RT::LocalPath/lib" if $RT::LocalPath;
@@ -33,451 +35,12 @@ sub RTxInitDB {
"--datadir" => "etc",
(($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
"--dba" => $RT::DatabaseUser,
- "--prompt-for-dba-password" => ''
+ "--prompt-for-dba-password" => '',
+ (RT::System->can('AddUpgradeHistory') ? ("--package" => $name, "--ext-version" => $version) : ()),
);
+
print "$^X @args\n";
(system($^X, @args) == 0) or die "...returned with error: $?\n";
}
-sub RTxFactory {
- my ($self, $RTx, $name, $drop) = @_;
- my $namespace = "$RTx\::$name";
-
- $self->RTxInit;
-
- my $dbh = $RT::Handle->dbh;
- # get all tables out of database
- my @tables = $dbh->tables;
- my ( %tablemap, %typemap, %modulemap );
- my $driver = $RT::DatabaseType;
-
- my $CollectionBaseclass = 'RT::SearchBuilder';
- my $RecordBaseclass = 'RT::Record';
- my $LicenseBlock = << '.';
-# BEGIN LICENSE BLOCK
-#
-# END LICENSE BLOCK
-.
- my $Attribution = << '.';
-# Autogenerated by Module::Intall::RTx::Factory
-# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
-#
-# !! DO NOT EDIT THIS FILE !!
-#
-
-use strict;
-.
- my $RecordInit = '';
-
- @tables = map { do { {
- my $table = $_;
- $table =~ s/.*\.//g;
- $table =~ s/\W//g;
- $table =~ s/^\Q$name\E_//i or next;
- $table ne 'sessions' or next;
-
- $table = ucfirst(lc($table));
- $table =~ s/$_/\u$_/ for qw(field group custom member value);
- $table =~ s/(?<=Scrip)$_/\u$_/ for qw(action condition);
- $table =~ s/$_/\U$_/ for qw(Acl);
- $table = $name . '_' . $table;
-
- $tablemap{$table} = $table;
- $modulemap{$table} = $table;
- if ( $table =~ /^(.*)s$/ ) {
- $tablemap{$1} = $table;
- $modulemap{$1} = $1;
- }
- $table;
- } } } @tables;
-
- $tablemap{'CreatedBy'} = 'User';
- $tablemap{'UpdatedBy'} = 'User';
-
- $typemap{'id'} = 'ro';
- $typemap{'Creator'} = 'auto';
- $typemap{'Created'} = 'auto';
- $typemap{'Updated'} = 'auto';
- $typemap{'UpdatedBy'} = 'auto';
- $typemap{'LastUpdated'} = 'auto';
- $typemap{'LastUpdatedBy'} = 'auto';
-
- $typemap{lc($_)} = $typemap{$_} for keys %typemap;
-
- foreach my $table (@tables) {
- if ($drop) {
- $dbh->do("DROP TABLE $table");
- $dbh->do("DROP sequence ${table}_id_seq") if $driver eq 'Pg';
- $dbh->do("DROP sequence ${table}_seq") if $driver eq 'Oracle';
- next;
- }
-
- my $tablesingle = $table;
- $tablesingle =~ s/^\Q$name\E_//i;
- $tablesingle =~ s/s$//;
- my $tableplural = $tablesingle . "s";
-
- if ( $tablesingle eq 'ACL' ) {
- $tablesingle = "ACE";
- $tableplural = "ACL";
- }
-
- my %requirements;
-
- my $CollectionClassName = $namespace . "::" . $tableplural;
- my $RecordClassName = $namespace . "::" . $tablesingle;
-
- my $path = $namespace;
- $path =~ s/::/\//g;
-
- my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
- my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
-
- #create a collection class
- my $CreateInParams;
- my $CreateOutParams;
- my $ClassAccessible = "";
- my $FieldsPod = "";
- my $CreatePod = "";
- my $CreateSub = "";
- my %fields;
- my $sth = $dbh->prepare("DESCRIBE $table");
-
- if ( $driver eq 'Pg' ) {
- $sth = $dbh->prepare(<<".");
- SELECT a.attname, format_type(a.atttypid, a.atttypmod),
- a.attnotnull, a.atthasdef, a.attnum
- FROM pg_class c, pg_attribute a
- WHERE c.relname ILIKE '$table'
- AND a.attnum > 0
- AND a.attrelid = c.oid
-ORDER BY a.attnum
-.
- }
- elsif ( $driver eq 'mysql' ) {
- $sth = $dbh->prepare("DESCRIBE $table");
- }
- else {
- die "$driver is currently unsupported";
- }
-
- $sth->execute;
-
- while ( my $row = $sth->fetchrow_hashref() ) {
- my ( $field, $type, $default );
- if ( $driver eq 'Pg' ) {
-
- $field = $row->{'attname'};
- $type = $row->{'format_type'};
- $default = $row->{'atthasdef'};
-
- if ( $default != 0 ) {
- my $tth = $dbh->prepare(<<".");
-SELECT substring(d.adsrc for 128)
- FROM pg_attrdef d, pg_class c
- WHERE c.relname = 'acct'
- AND c.oid = d.adrelid
- AND d.adnum = $row->{'attnum'}
-.
- $tth->execute();
- my @default = $tth->fetchrow_array;
- $default = $default[0];
- }
-
- }
- elsif ( $driver eq 'mysql' ) {
- $field = $row->{'Field'};
- $type = $row->{'Type'};
- $default = $row->{'Default'};
- }
-
- $fields{$field} = 1;
-
- #generate the 'accessible' datastructure
-
- if ( $typemap{$field} eq 'auto' ) {
- $ClassAccessible .= " $field =>
- {read => 1, auto => 1,";
- }
- elsif ( $typemap{$field} eq 'ro' ) {
- $ClassAccessible .= " $field =>
- {read => 1,";
- }
- else {
- $ClassAccessible .= " $field =>
- {read => 1, write => 1,";
-
- }
-
- $ClassAccessible .= " type => '$type', default => '$default'},\n";
-
- #generate pod for the accessible fields
- $FieldsPod .= $self->_pod(<<".");
-^head2 $field
-
-Returns the current value of $field.
-(In the database, $field is stored as $type.)
-
-.
-
- unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
- $FieldsPod .= $self->_pod(<<".");
-
-^head2 Set$field VALUE
-
-
-Set $field to VALUE.
-Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
-(In the database, $field will be stored as a $type.)
-
-.
- }
-
- $FieldsPod .= $self->_pod(<<".");
-^cut
-
-.
-
- if ( $modulemap{$field} ) {
- $FieldsPod .= $self->_pod(<<".");
-^head2 ${field}Obj
-
-Returns the $modulemap{$field} Object which has the id returned by $field
-
-
-^cut
-
-sub ${field}Obj {
- my \$self = shift;
- my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
- \$$field->Load(\$self->__Value('$field'));
- return(\$$field);
-}
-.
- $requirements{ $tablemap{$field} } =
- "use ${namespace}::$modulemap{$field};";
-
- }
-
- unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
-
- #generate create statement
- $CreateInParams .= " $field => '$default',\n";
- $CreateOutParams .=
- " $field => \$args{'$field'},\n";
-
- #gerenate pod for the create statement
- $CreatePod .= " $type '$field'";
- $CreatePod .= " defaults to '$default'" if ($default);
- $CreatePod .= ".\n";
-
- }
-
- }
-
- $CreateSub = <<".";
-sub Create {
- my \$self = shift;
- my \%args = (
-$CreateInParams
- \@_);
- \$self->SUPER::Create(
-$CreateOutParams);
-
-}
-.
- $CreatePod .= "\n=cut\n\n";
-
- my $CollectionClass = $LicenseBlock . $Attribution . $self->_pod(<<".") . $self->_magic_import($CollectionClassName);
-
-^head1 NAME
-
-$CollectionClassName -- Class Description
-
-^head1 SYNOPSIS
-
-use $CollectionClassName
-
-^head1 DESCRIPTION
-
-
-^head1 METHODS
-
-^cut
-
-package $CollectionClassName;
-
-use $CollectionBaseclass;
-use $RecordClassName;
-
-use vars qw( \@ISA );
-\@ISA= qw($CollectionBaseclass);
-
-
-sub _Init {
- my \$self = shift;
- \$self->{'table'} = '$table';
- \$self->{'primary_key'} = 'id';
-
-.
-
- if ( $fields{'SortOrder'} ) {
-
- $CollectionClass .= $self->_pod(<<".");
-
-# By default, order by name
-\$self->OrderBy( ALIAS => 'main',
- FIELD => 'SortOrder',
- ORDER => 'ASC');
-.
- }
- $CollectionClass .= $self->_pod(<<".");
- return ( \$self->SUPER::_Init(\@_) );
-}
-
-
-^head2 NewItem
-
-Returns an empty new $RecordClassName item
-
-^cut
-
-sub NewItem {
- my \$self = shift;
- return($RecordClassName->new(\$self->CurrentUser));
-}
-.
-
- my $RecordClassHeader = $Attribution . "
-
-^head1 NAME
-
-$RecordClassName
-
-
-^head1 SYNOPSIS
-
-^head1 DESCRIPTION
-
-^head1 METHODS
-
-^cut
-
-package $RecordClassName;
-use $RecordBaseclass;
-";
-
- foreach my $key ( keys %requirements ) {
- $RecordClassHeader .= $requirements{$key} . "\n";
- }
- $RecordClassHeader .= <<".";
-
-use vars qw( \@ISA );
-\@ISA= qw( $RecordBaseclass );
-
-sub _Init {
-my \$self = shift;
-
-\$self->Table('$table');
-\$self->SUPER::_Init(\@_);
-}
-
-.
-
- my $RecordClass = $LicenseBlock . $RecordClassHeader . $self->_pod(<<".") . $self->_magic_import($RecordClassName);
-
-$RecordInit
-
-^head2 Create PARAMHASH
-
-Create takes a hash of values and creates a row in the database:
-
-$CreatePod
-
-$CreateSub
-
-$FieldsPod
-
-sub _CoreAccessible {
- {
-
-$ClassAccessible
-}
-};
-
-.
-
- print "About to make $RecordClassPath, $CollectionClassPath\n";
- `mkdir -p $path`;
-
- open( RECORD, ">$RecordClassPath" );
- print RECORD $RecordClass;
- close(RECORD);
-
- open( COL, ">$CollectionClassPath" );
- print COL $CollectionClass;
- close(COL);
-
- }
-}
-
-sub _magic_import {
- my $self = shift;
- my $class = ref($self) || $self;
-
- #if (exists \$warnings::{unimport}) {
- # no warnings qw(redefine);
-
- my $path = $class;
- $path =~ s#::#/#gi;
-
-
- my $content = $self->_pod(<<".");
- eval \"require ${class}_Overlay\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Overlay.pm}) {
- die \$@;
- };
-
- eval \"require ${class}_Vendor\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Vendor.pm}) {
- die \$@;
- };
-
- eval \"require ${class}_Local\";
- if (\$@ && \$@ !~ qr{^Can't locate ${path}_Local.pm}) {
- die \$@;
- };
-
-
-
-
-^head1 SEE ALSO
-
-This class allows \"overlay\" methods to be placed
-into the following files _Overlay is for a System overlay by the original author,
-_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
-
-These overlay files can contain new subs or subs to replace existing subs in this module.
-
-If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
-
- no warnings qw(redefine);
-
-so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
-
-${class}_Overlay, ${class}_Vendor, ${class}_Local
-
-^cut
-
-
1;
-.
-
- return $content;
-}
-
-sub _pod {
- my ($self, $text) = @_;
- $text =~ s/^\^/=/mg;
- return $text;
-}
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index 348531e..6a80818 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,29 +7,119 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.12';
+$VERSION = '0.20';
sub readme_from {
my $self = shift;
return unless $self->is_admin;
- my $file = shift || $self->_all_from
+ # Input file
+ my $in_file = shift || $self->_all_from
or die "Can't determine file to make readme_from";
- my $clean = shift;
- print "Writing README from $file\n";
+ # 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);
+ }
- require Pod::Text;
- my $parser = Pod::Text->new();
- open README, '> README' or die "$!\n";
- $parser->output_fh( *README );
- $parser->parse_file( $file );
if ($clean) {
- $self->clean_files('README');
+ $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};
@@ -44,5 +134,5 @@ sub _all_from {
__END__
-#line 112
+#line 254
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index edc18b4..eeaa3fe 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index d0f6599..85d8018 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.00';
+ $VERSION = '1.06';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
commit e4cd0133e7c61ee9e1f019196c763654604f25cb
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Mar 26 16:15:43 2013 +0400
update .gitignore
diff --git a/.gitignore b/.gitignore
index 067e656..4ac8fb2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,5 @@ pm_to_blib
*.old
*.bak
*.swp
+MYMETA.*
+t/tmp/
commit 7dfcf3ea8762f67f179ba960a089ab07ab7e916e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Tue Mar 26 16:16:49 2013 +0400
bump version, 0.02
diff --git a/META.yml b/META.yml
index e0ac7af..edd81dc 100644
--- a/META.yml
+++ b/META.yml
@@ -24,4 +24,4 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: 0.01
+version: 0.02
diff --git a/lib/RT/Extension/ACNS.pm b/lib/RT/Extension/ACNS.pm
index cb55b3c..dba2f74 100644
--- a/lib/RT/Extension/ACNS.pm
+++ b/lib/RT/Extension/ACNS.pm
@@ -4,7 +4,7 @@ use warnings;
package RT::Extension::ACNS;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 NAME
diff --git a/lib/RT/Extension/ACNS/Test.pm b/lib/RT/Extension/ACNS/Test.pm
index a9a8205..c3f45f3 100644
--- a/lib/RT/Extension/ACNS/Test.pm
+++ b/lib/RT/Extension/ACNS/Test.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
### after: use lib qw(@RT_LIB_PATH@);
-use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
package RT::Extension::ACNS::Test;
commit 305e62bf27a6a73d2afd7264d6fbee9bb9739776
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Apr 11 01:20:12 2013 +0400
extract from verified emails
after GPG verification '- ---END ACNS' becomes '---END ACNS'
add tests
diff --git a/lib/RT/Action/ParseACNS.pm b/lib/RT/Action/ParseACNS.pm
index 76899e0..63d82f3 100644
--- a/lib/RT/Action/ParseACNS.pm
+++ b/lib/RT/Action/ParseACNS.pm
@@ -16,7 +16,7 @@ sub Prepare {
my $content = $txn->Content;
if ( $content =~ s/^.*Start ACNS XML\n//s ) {
- $content =~ s/- -+End ACNS XML.*$//s;
+ $content =~ s/(- )?-+End ACNS XML.*$//s;
$xml = XML::LibXML->new->parse_string( $content );
} else {
my $attachments = $txn->Attachments;
diff --git a/t/data/sample1.eml b/t/data/sample1.eml
new file mode 100644
index 0000000..8e158f1
--- /dev/null
+++ b/t/data/sample1.eml
@@ -0,0 +1,68 @@
+MIME-Version: 1.0
+Content-Transfer-Encoding: quoted-printable
+Content-Type: text/plain; charset="utf-8"
+Date: Sun, 7 Apr 2013 03:41:10 -0500
+From: root at localhost
+Subject: Copyright Infringement - Notice ID # 22273283246
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+04-07-2013
+
+free form will be ignored.=0A=0A- ---Start ACNS XM=
+L=0A<?xml version=3D"1.0" encoding=3D"UTF-8"?>=20
+<Infringement xsi:schemaLocation=3D"http://www.acns.net/ACNS http://www.=
+acns.net/v1.2/ACNS2v1_2.xsd" xmlns=3D"http://www.acns.net/ACNS" xmlns:xs=
+i=3D"http://www.w3.org/2001/XMLSchema-instance"> <Case>
+ <ID>A1234567890</ID>=20
+ <Status>OPEN</Status>=20
+ <Severity>Normal</Severity>=20
+ <Ref_URL></Ref_URL>
+ </Case>
+ <Complainant>
+ <Entity>Trust</Entity>=20
+ <Contact>Friend</Contact>=20
+ <Address>Hell</Address>=20
+ <Phone>666</Phone>=20
+ <Email>you.took.my.toy at example.com</Email>=20
+ </Complainant>
+ <Service_Provider>
+ <Entity>IT Dude</Entity>=20
+ <Contact>Admin</Contact>=20
+ <Address>Server Room</Address>=20
+ <Phone>911</Phone>
+ <Email>dirty.beardy.smelly at example.com</Email>=20
+ </Service_Provider>
+ <Source>
+ <TimeStamp>2013-04-06T20:02:41.99Z</TimeStamp>=20
+ <IP_Address>123.123.123.123</IP_Address>=20
+ <Port>39671</Port>=20
+ <DNS_Name>some.name.example.com</DNS_Name>
+ <Type>P2P</Type>=20
+ <SubType BaseType=3D"P2P" Protocol=3D"BITTORRENT" />
+ <Number_Files>1</Number_Files>=20
+ <IsSource>false</IsSource>
+ </Source>
+ <Content>
+ <Item>
+ <TimeStamp>2013-04-06T20:02:41.99Z</TimeStamp>=20
+ <AlsoSeen Start=3D"2013-04-06T19:59:43.46Z" End=3D"2013-04-06T20:00:3=
+6.27Z"></AlsoSeen>
+ <Title>booo</Title>=20
+ <Artist></Artist>
+ <FileName>example.file.exe</FileName>=20
+ <FileSize>1234567890</FileSize>=20
+ <Type>Game</Type>=20
+ <Hash Type=3D"SHA1">1234567890</Hash>
+ </Item>
+ </Content>
+<History></History>=20
+<Notes></Notes>
+</Infringement>=0A- ---End ACNS XML=0A-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.4.10 (MingW32)
+
+iEYEARECAAYFAlFhMSYACgkQxDbGXOV1jVIojQCdF6XVD/kYs3aQpZzSdeG01Ryj
+TvgAmgOaTCP3G6Mne2oQlsZfZRhNSEg+
+=3DQZUp
+-----END PGP SIGNATURE-----
diff --git a/t/data/sample2.eml b/t/data/sample2.eml
new file mode 100644
index 0000000..87efdd0
--- /dev/null
+++ b/t/data/sample2.eml
@@ -0,0 +1,59 @@
+MIME-Version: 1.0
+Content-Transfer-Encoding: quoted-printable
+Content-Type: text/plain; charset="utf-8"
+Date: Sun, 7 Apr 2013 03:41:10 -0500
+From: root at localhost
+Subject: Copyright Infringement - Notice ID # 22273283246
+
+04-07-2013
+
+free form will be ignored.=0A=0A---Start ACNS XM=
+L=0A<?xml version=3D"1.0" encoding=3D"UTF-8"?>=20
+<Infringement xsi:schemaLocation=3D"http://www.acns.net/ACNS http://www.=
+acns.net/v1.2/ACNS2v1_2.xsd" xmlns=3D"http://www.acns.net/ACNS" xmlns:xs=
+i=3D"http://www.w3.org/2001/XMLSchema-instance"> <Case>
+ <ID>A1234567890</ID>=20
+ <Status>OPEN</Status>=20
+ <Severity>Normal</Severity>=20
+ <Ref_URL></Ref_URL>
+ </Case>
+ <Complainant>
+ <Entity>Trust</Entity>=20
+ <Contact>Friend</Contact>=20
+ <Address>Hell</Address>=20
+ <Phone>666</Phone>=20
+ <Email>you.took.my.toy at example.com</Email>=20
+ </Complainant>
+ <Service_Provider>
+ <Entity>IT Dude</Entity>=20
+ <Contact>Admin</Contact>=20
+ <Address>Server Room</Address>=20
+ <Phone>911</Phone>
+ <Email>dirty.beardy.smelly at example.com</Email>=20
+ </Service_Provider>
+ <Source>
+ <TimeStamp>2013-04-06T20:02:41.99Z</TimeStamp>=20
+ <IP_Address>123.123.123.123</IP_Address>=20
+ <Port>39671</Port>=20
+ <DNS_Name>some.name.example.com</DNS_Name>
+ <Type>P2P</Type>=20
+ <SubType BaseType=3D"P2P" Protocol=3D"BITTORRENT" />
+ <Number_Files>1</Number_Files>=20
+ <IsSource>false</IsSource>
+ </Source>
+ <Content>
+ <Item>
+ <TimeStamp>2013-04-06T20:02:41.99Z</TimeStamp>=20
+ <AlsoSeen Start=3D"2013-04-06T19:59:43.46Z" End=3D"2013-04-06T20:00:3=
+6.27Z"></AlsoSeen>
+ <Title>booo</Title>=20
+ <Artist></Artist>
+ <FileName>example.file.exe</FileName>=20
+ <FileSize>1234567890</FileSize>=20
+ <Type>Game</Type>=20
+ <Hash Type=3D"SHA1">1234567890</Hash>
+ </Item>
+ </Content>
+<History></History>=20
+<Notes></Notes>
+</Infringement>=0A---End ACNS XML=0A
diff --git a/t/samples.t b/t/samples.t
new file mode 100644
index 0000000..29a7a66
--- /dev/null
+++ b/t/samples.t
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use RT::Extension::ACNS::Test tests => undef;
+
+my $cf_single;
+{
+ my $cf = RT::CustomField->new( $RT::SystemUser );
+ my ($ret, $msg) = $cf->Create(
+ Name => 'TextSingle',
+ Queue => 'General',
+ Type => 'TextSingle',
+ );
+ ok($ret, "created Custom Field");
+ $cf_single = $cf;
+}
+
+RT->Config->Set(ACNS =>
+ Map => { $cf_single->id => [qw(Case ID)] },
+);
+
+foreach my $file ( glob "t/data/*.eml" ) {
+ my ( $status, $id ) = RT::Test->send_via_mailgate(RT::Test->file_content($file));
+ ok($id, 'created a ticket');
+
+ my $ticket = RT::Ticket->new( $RT::SystemUser );
+ $ticket->Load($id);
+ is($ticket->FirstCustomFieldValue($cf_single->id), 'A1234567890', "CF value");
+}
+
+done_testing();
+
commit 93e8a6b2bb8718c2fe24e33b0554fefb39a6a02d
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Apr 11 01:24:51 2013 +0400
bump version, 0.03
diff --git a/MANIFEST b/MANIFEST
index ab35f33..16f3813 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,4 +1,3 @@
-.gitignore
Changes
etc/initialdata
etc/RT_ACNSConfig.pm
@@ -23,3 +22,6 @@ MANIFEST This list of files
META.yml
README
t/basics.t
+t/data/sample1.eml
+t/data/sample2.eml
+t/samples.t
diff --git a/META.yml b/META.yml
index edd81dc..a011766 100644
--- a/META.yml
+++ b/META.yml
@@ -24,4 +24,4 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: 0.02
+version: 0.03
diff --git a/lib/RT/Extension/ACNS.pm b/lib/RT/Extension/ACNS.pm
index dba2f74..261d3ed 100644
--- a/lib/RT/Extension/ACNS.pm
+++ b/lib/RT/Extension/ACNS.pm
@@ -4,7 +4,7 @@ use warnings;
package RT::Extension::ACNS;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 NAME
commit 3806fd22c9dd03dabb986f29adbd06ece375027b
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Apr 25 17:22:20 2013 +0400
update changelog for previous versions
diff --git a/Changes b/Changes
index d1f19e8..5de974a 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,11 @@
+0.03 2013-04-11
+
+ * extract from a verified emails (gpg strips some bits)
+
+0.02 2013-03-26
+
+ * extract from XML in an attachment
+
0.01 2011-02-04
* initial release
commit d4b6427bd5d7e90924a262363c7ffbb6b956b013
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Apr 25 17:31:06 2013 +0400
support functions in config for tricky maps
diff --git a/MANIFEST b/MANIFEST
index 16f3813..f49c18c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,6 +22,7 @@ MANIFEST This list of files
META.yml
README
t/basics.t
+t/callbacks.t
t/data/sample1.eml
t/data/sample2.eml
t/samples.t
diff --git a/etc/RT_ACNSConfig.pm b/etc/RT_ACNSConfig.pm
index 35a51e5..fda45c8 100644
--- a/etc/RT_ACNSConfig.pm
+++ b/etc/RT_ACNSConfig.pm
@@ -17,7 +17,8 @@ with ( custom field => value ) pairs. For example:
Map is hash with (custom field => path) pairs, where path
is an array reference with node names from ACNS XML. More
-on paths below.
+on paths below. Path can be a function, more on this
+after simple solution.
Set( %ACNS =>
Defaults => { ... },
@@ -68,6 +69,26 @@ name with attribute name to store text. For example:
=back
+As mentioned path can be a function that generates value(s), for example the following
+code combines optional elements that define type of the source into one value:
+
+ Set( %ACNS =>
+ Map => {
+ SourceType => sub {
+ my %args = @_;
+ return () unless exists $args{'Data'}{'Source'};
+
+ my $source = $args{'Data'}{'Source'};
+ my @res = (
+ $source->{'Type'}, @{ $source->{'SubType'} }{'BaseType', 'Protocol'}
+ );
+ my %seen;
+ return join ' ', grep !$seen{$_}++, map lc $_,
+ grep defined && length, @res;
+ },
+ },
+ );
+
=cut
Set( %ACNS =>
diff --git a/lib/RT/Action/ParseACNS.pm b/lib/RT/Action/ParseACNS.pm
index 63d82f3..058dd4c 100644
--- a/lib/RT/Action/ParseACNS.pm
+++ b/lib/RT/Action/ParseACNS.pm
@@ -143,12 +143,20 @@ sub MapDataOverCFs {
return \%res unless $config{'Map'};
while ( my ($cf, $path) = each %{ $config{'Map'} } ) {
- my @tmp = grep defined && length, $self->ResolveMapEntry(
- Data => $data,
- Path => $path,
- CustomField => $cf,
- );
- $res{ $cf } = @tmp > 1 ? [ @tmp ] : @tmp? $tmp[0] : undef;
+ my @res;
+ if ( ref($path) eq 'CODE' ) {
+ @res = grep defined && length, $path->(
+ Data => $data,
+ CustomField => $cf,
+ );
+ } else {
+ @res = grep defined && length, $self->ResolveMapEntry(
+ Data => $data,
+ Path => $path,
+ CustomField => $cf,
+ );
+ }
+ $res{ $cf } = @res > 1 ? [ @res ] : @res? $res[0] : undef;
}
return \%res;
}
diff --git a/t/callbacks.t b/t/callbacks.t
new file mode 100644
index 0000000..bead0ec
--- /dev/null
+++ b/t/callbacks.t
@@ -0,0 +1,49 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use RT::Extension::ACNS::Test tests => undef;
+
+my $cf;
+{
+ $cf = RT::CustomField->new( $RT::SystemUser );
+ my ($ret, $msg) = $cf->Create(
+ Name => 'Text',
+ Queue => 'General',
+ Type => 'FreeformMultiple',
+ );
+ ok($ret, "created Custom Field");
+}
+
+RT->Config->Set(ACNS =>
+ Map => {
+ $cf->id => sub {
+ my %args = @_;
+ return () unless exists $args{'Data'}{'Source'};
+ my $source = $args{'Data'}{'Source'};
+ my @res = (
+ $source->{'Type'}, @{ $source->{'SubType'} }{'BaseType', 'Protocol'}
+ );
+ my %seen;
+ return join ' ', grep !$seen{$_}++, map lc $_,
+ grep defined && length, @res;
+ },
+ },
+);
+
+foreach my $file ( glob "t/data/*.eml" ) {
+ my ( $status, $id ) = RT::Test->send_via_mailgate(RT::Test->file_content($file));
+ ok($id, 'created a ticket');
+
+ my $ticket = RT::Ticket->new( $RT::SystemUser );
+ $ticket->Load($id);
+ is_deeply(
+ [ map $_->Content, @{ $ticket->CustomFieldValues($cf->id)->ItemsArrayRef } ],
+ [ 'p2p bittorrent' ],
+ "CF value is correct"
+ );
+}
+
+done_testing();
+
commit aa099bf09330c1223e18d8b5c4dfeb6bb0c8f5a9
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Apr 25 17:32:12 2013 +0400
bump version, 0.04
diff --git a/Changes b/Changes
index 5de974a..4878575 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,7 @@
+0.04 2013-04-25
+
+ * add support for functions in the map
+
0.03 2013-04-11
* extract from a verified emails (gpg strips some bits)
diff --git a/META.yml b/META.yml
index a011766..d8655c5 100644
--- a/META.yml
+++ b/META.yml
@@ -24,4 +24,4 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: 0.03
+version: 0.04
diff --git a/lib/RT/Extension/ACNS.pm b/lib/RT/Extension/ACNS.pm
index 261d3ed..f331b7d 100644
--- a/lib/RT/Extension/ACNS.pm
+++ b/lib/RT/Extension/ACNS.pm
@@ -4,7 +4,7 @@ use warnings;
package RT::Extension::ACNS;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
=head1 NAME
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list