[rt-devel] rt-summarise: 1.3
Bruce Campbell
bruce_campbell at ripe.net
Wed Nov 6 12:25:25 EST 2002
The attached file does two things (selectable):
a) a basic job of summarising all requests received by a given
queue over a given time period, from a given domain name, from
a particular company (or some of the above), in your choice of
'full' or 'brief' formats.
As an example:
rt-summarise.pl --summary brief --queue DNS
--start "2002-11-06 00:00:00" --domain "ripe.net"
Summary for:
Queue: DNS
Starting: 2002-11-06 00:00:00
Total Found: 4
RIPE NCC - Operations Group : 1
RIPE NCC - Registration Services : 3
b) Modify the Organization field all RT::User objects in a certain
domain according to fields in a certain file. In the case of
the RIPE NCC, we've modified every RT User object with an email
address @ripe.net to have:
'RIPE NCC - Name of section'
with the intent that the company option to (a) just takes the
first section. Some modification of an internal routine is
required to use this, as the format of file that I use for
reference (an employee listing file) probably won't meet with
your requirements.
I run something like:
rt-summarise.pl --company "RIPE NCC" --domain "ripe.net"
--matchfile employees.lst
On a monthly basis to keep RT up to date with staff changes.
Note that a lot of the guff in the program file is basically Getopt::Long
on drugs.
Regards,
--
Bruce Campbell RIPE
Systems/Network Engineer NCC
www.ripe.net - PGP562C8B1B Operations/Security
-------------- next part --------------
#!/usr/bin/perl -w
###############################################################################
## @(#) $Id: rt-summarise.pl,v 1.3 2002/11/05 10:44:43 bc Exp $
##
## rt-summarise.pl - Provides summaries of RT Queues.
##
## Copyright (C) 2002 Author and Company
##
## This program is free software; you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation; either version 1, or (at your option)
## any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##
###############################################################################
##
## This is a Template.
##
###############################################################################
###############################################################################
## S E C U R I T Y
###############################################################################
# IF this program is run as ROOT, do secure setup.
# die "error: perl library is writable by others !\n" if $< && -W $INC[0];
$ENV{'IFS'} = '' if $ENV{'IFS'}; # plug sh security hole
# $ENV{'PATH'} = '/bin:/usr/bin'; # or whatever you need
$ENV{'SHELL'} = '/usr/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
# umask(077);
###############################################################################
## L I B R A R I E S / M O D U L E S
###############################################################################
use strict;
use Getopt::Long;
###############################################################################
## G L O B A L V A R I A B L E S
###############################################################################
use vars qw($VERSION); # pre-declare the version no.
$VERSION = do { my @r=(q$Revision: 1.3 $=~/\d+/g); sprintf "%d."."%02d"x$#r, at r};
###############################################################################
## M E T H O D S
###############################################################################
sub warranty()
{
my ( $opt, %opts ) = (@_);
my $retval = 0;
if( $opt eq "warranty" ){
$retval = 1;
print << 'EOM' ;
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
EOM
exit 0;
}elsif( $opt eq "selfcheck" ){
$retval = "warranty: complete";
}
return( $retval );
}
sub copyright()
{
print << 'EOM' ;
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
EOM
exit 0;
}
sub version()
{
my $ldate = '$Date: 2002/11/05 10:44:43 $';
my $lauthor = '$Author: bc $';
print "$0: Version: $VERSION Last Update: $ldate by $lauthor\n";
}
###############################################################################
## E N V I R O N M E N T
###############################################################################
{ # Begin local variable scope for %argv_meta and %task_meta
# This construct defines all of the possible arguments, also used for
# the usage command.
#
# It consists of:
# formal-name
# desc description of the name
# expects <Tokens> of what is expected as arguments.
# real What to remap this argument, and it's 'expects',
# into. Does <token> replacement, assuming the
# <token> text is unique.
# getopt Is this a candidate for passing to GetOptions
# ( and what is the format for this )
# sub Which subroutine to call for this argument
# visible Controls whether this argument is visible/usable under
# the current defined behaviour. Can be a variation on
# 'yes/true/1' for always visible, or can contain a
# behaviour name (see Variations).
# usage Normally dynamically created with the formal name and
# the expects, however will not overwrite it.
# precedence Should this option be checked for existence first?
# default The default value to put in this field, if nothing
# was supplied.
# argv What to match in @ARGV. Normally used as argv_style,
# where style is variable (see Variations). Use
# argv_default.
# isreal Whether this argument is 'real', in that it does
# something, or just sets an option. Affects the
# counting of valid arguments in main().
#
# Variations
# The routine argv_behaviour controls what behaviour this script
# exhibits. When matching command line arguments, the following
# is searched for:
# $argv_meta{"$formal-name"}{"$style"}
# (where $style is returned by argv_behaviour() )
# "--$formal-name"
#
# When remapping command line arguments, the mapping is done via
# the contents of:
# $argv_meta{"$formal-name"}{"$real" . "_" . "$style"}
# or
# $argv_meta{"$formal-name"}{"$real"}
# whichever is found first.
#
my %argv_meta = (
"dummy" => {
expects => "<num> <text>",
},
"__MaGiC-parse-error" => {
desc => "Do not delete this option. It is used by &argv_correct() and &display_parse_errors() to pass information about errors in parsing options to one another.",
expects => "<text>",
getopt => "=s@",
visible => "no",
precedence => "yes",
sub => \&display_parse_errors,
},
copyright => {
desc => "Display copyright message",
getopt => "",
sub => \©right,
precedence => "yes",
isreal => "1",
},
warranty => {
desc => "Display warranty message",
getopt => "",
sub => \&warranty,
precedence => "yes",
isreal => "1",
},
help => {
desc => "Display help message (this text)",
getopt => "",
sub => \&usage,
precedence => "yes",
isreal => "1",
},
version => {
desc => "Show the version number of this program",
getopt => "",
sub => \&version,
precedence => "yes",
isreal => "1",
},
debug => {
desc => "Show debugging information",
getopt => "=i",
expects => "<num>",
default => "0",
precedence => "yes",
sub => \&set_debug,
},
company => {
desc => "Set the Company name",
expects => "<text>",
getopt => "=s",
precedence => "yes",
sub => \&set_company,
},
domain => {
desc => "Match users from this domain",
expects => "<domain>",
getopt => "=s",
precedence => "yes",
sub => \&set_domain,
},
matchfile => {
desc => "Filename that matches email addresses to departments ( username tab department )",
expects => "<file>",
getopt => "=s",
sub => \&do_match,
isreal => "1",
},
start => {
desc => "Set the start date for summaries",
expects => "<date>",
getopt => "=s",
sub => \&set_date,
precedence => "yes",
},
end => {
desc => "Set the end date",
expects => "<date>",
getopt => "=s",
sub => \&set_date,
precedence => "yes",
},
summary => {
desc => "Set the summary type (brief, full)",
expects => "<text>",
getopt => "=s",
sub => \&do_summary,
isreal => "1",
},
queue => {
desc => "Set the queue to do a summary on",
expects => "<text>",
getopt => "=s",
precedence => "yes",
sub => \&set_queue,
},
_self_check => {
desc => "perform a self check (internal use)",
usage => "",
getopt => "",
sub => \&do_self_check,
visible => "no",
},
);
###############################################################################
## A R G V M A N I P U L A T I O N S
###############################################################################
##
## These functions manipulate @ARGV according to %argv_meta.
##
# This is a helper functions to selfcheck, and for doing partial matches.
sub argv_list_options(){
my $style = shift;
my $partial = shift;
$style=&argv_behaviour if( ! defined ( $style ) );
$style="internal" if( ! defined ( $style ) );
$partial = "" if( ! defined( $partial ) );
my $retval = "";
# Walk through %argv_meta, list the options.
foreach my $kkey ( keys %argv_meta ) {
# Should we look this one up?
my $real_arg = undef;
if( defined( $argv_meta{"$kkey"}{"visible"} ) ){
if( $argv_meta{"$kkey"}{"visible"} eq /$style/ ){
if( defined( $argv_meta{"$kkey"}{"$style"} ) ){
$real_arg = $argv_meta{"$kkey"}{"$style"};
}else{
$real_arg = "--$kkey";
}
}
}else{
$real_arg = "--$kkey";
}
# Force the looking if its internal.
$real_arg = "--$kkey" if( ! defined( $real_arg ) && $style eq "internal" );
# Do we admit to knowing about it?
if( defined( $real_arg ) ){
my $dashes = "";
my $rest = "";
if( $real_arg =~ /^(-+)?([^-]\S+)$/ ){
$rest=$2;
$dashes=$1 if( defined( $1 ) );
}
# Do our partial search.
if( length( $partial ) <= length( $rest ) ){
my $t_1 = substr( $rest, 0, length( $partial ) );
if( $t_1 eq $partial ){
$retval .= " " . $real_arg
}
}
}
}
# Return whatever we found.
return( $retval );
}
##
## Define what behaviour we're going to exhibit when doing searches for
## options. Cache the result. Remember to keep argv_possible_behaviours()
## up to date.
##
my $behaviour = undef;
sub argv_behaviour(){
## $behaviour should be outside this subroutine.
if( ! defined( $behaviour ) ){
## Put in here any tests against $0 to set $behaviour.
$behaviour = "standard";
}
return( $behaviour );
}
##
## List possible behaviours usable in a pattern match
##
sub argv_possible_behaviours(){
# Return the possible behaviours as a string usable in a pattern match
return( "standard" );
}
##
## Retrieve a string from %argv_meta (for subroutines operating outside the
## local scope ).
##
sub argv_meta_retrieve(){
my $arg = shift;
my $subarg = shift;
my $style = shift;
$style = &argv_behaviour if( ! defined( $style ) );
$style = "" if( ! defined( $style ) );
my $retval = undef;
if( defined( $arg ) && defined( $subarg ) ){
if( defined( $argv_meta{"$arg"}{"$subarg" . "_" . "$style"} ) ){
$retval = $argv_meta{"$arg"}{"$subarg" . "_" . "$style"};
}elsif( defined( $argv_meta{"$arg"}{"$subarg"} ) ){
$retval = $argv_meta{"$arg"}{"$subarg"};
}
if( defined( $retval ) ){
# print time . " argv_meta_retrieve: asked for $arg, $subarg, $style: found $retval\n";
}else{
# print time . " argv_meta_retrieve: asked for $arg, $subarg, $style: did not find anything\n";
}
}else{
# print time . " argv_meta_retrieve: called with one or more invalid arguments\n";
}
# sleep 1;
return( $retval );
}
##
## Fill in some default values if not specified.
##
sub argv_supply_defaults(){
my $opts = shift;
foreach my $kkey( keys %argv_meta ){
next if( defined( ${$opts}{"$kkey"} ) );
my $default = &argv_meta_retrieve( $kkey, "standard" );
next unless( defined( $default ) );
${$opts}{"$kkey"} = $default;
}
}
##
## Generate a precedence list based on %argv_meta
##
sub argv_precedence(){
my $retval_look = 0;
my %retval_hash = ();
my %check_hash = ();
my ($long_str) = (@_);
my @tsplit = split( /\s+/, $long_str );
foreach my $kkey( @tsplit ){
$check_hash{"$kkey"} = 1;
}
my $style = &argv_behaviour();
foreach my $kkey( keys %argv_meta ){
my $precedence_value = &argv_meta_retrieve( $kkey, "precedence" );
if( defined( $precedence_value ) && defined( $check_hash{"$kkey"} ) ){
if( $precedence_value =~ /yes|yeah|true|ja|hai|[123456789][0123456789]?|$style/i ){
$retval_look++;
$retval_hash{"$kkey"} = $precedence_value;
}
}
}
return( $retval_look, %retval_hash );
}
##
## Generate an array suitable for passing to GetOptions, based on %argv_meta
##
sub gen_GetOptions_array(){
my @retval = ();
foreach my $kkey( sort keys %argv_meta ){
my $getopt = &argv_meta_retrieve( $kkey, "getopt" );
if( defined( $getopt ) ){
push @retval, "$kkey" . $getopt;
}
}
return( @retval );
}
##
## Whether an argument is hidden or not.
##
sub ishidden(){
return(0);
}
##
## Whether an argument is visible or not under the current context.
##
sub isvisible(){
my $arg = shift;
my $retval = 0;
my $behaviour = &argv_behaviour();
if( defined( $arg ) ){
my $visible = &argv_meta_retrieve( $arg, "visible" );
if( defined( $visible ) ){
my $arg_pat = &argv_possible_behaviours();
# The curse of multiple languages.
if( $visible =~ /(no|nee|nay|iee|false|0)/i ){
$retval=0;
}elsif( $visible =~ /$arg_pat/i ){
if( $visible =~ /$behaviour/ ){
$retval=1;
}else{
# print "$arg - $arg_pat - $behaviour\n";
$retval=0;
}
}else{
$retval=1;
}
}else{
$retval=1;
}
}
return( $retval );
}
##
## see if we should invoke a subroutine for this argument.
##
sub which_sub(){
my $arg = shift;
return( &argv_meta_retrieve( $arg, "sub" ) );
}
##
## The fancy usage function.
##
sub usage () {
my $arg = shift;
# Walk through the argv_meta array.
print "$0 $VERSION, Copyright (C) 2002, Bruce Campbell\n";
print "$0 comes with ABSOLUTELY NO WARRANTY; This is free software,\n";
print "and you are welcome to redistribute it under certain conditions\n";
my $longest = 0;
my $style = &argv_behaviour();
$style = "standard" if( ! defined( $style ) );
## If you want to change the banner based on $style, here is the place
## to do it.
if( $style eq "somefunnystyle" ){
print "\nusage: $0 [command] [ticketnumber] [optional]\n\n";
}else{
print "\nusage: $0 [commands]\n\n";
}
## Run through finding the longest string.
##
my %usages = ();
foreach my $kkey ( keys %argv_meta ){
next if( ! &isvisible( $kkey ) );
next if( &ishidden( $kkey ) );
# Give a description
my $new_arg = &argv_meta_retrieve( $kkey, "usage" );
if( ! defined( $new_arg ) ){
$new_arg = &argv_meta_retrieve( $kkey, $style );
if( defined( $new_arg ) ){
$usages{"$kkey"} = $new_arg;
}else{
$usages{"$kkey"} = "--$kkey";
}
$new_arg = &argv_meta_retrieve( $kkey, "expects" );
if( defined( $new_arg ) ){
$usages{"$kkey"} .= " " . $new_arg;
}
}else{
$usages{"$kkey"} = $new_arg;
}
# Is the length of this one the longest?
if( length( $usages{"$kkey"} ) > $longest ){
$longest = length( $usages{"$kkey"} );
}
}
# Find out the width of the screen.
my $cols = 80;
$cols = $ENV{'COLUMNS'} if( defined( $ENV{'COLUMNS'} ) );
foreach my $kkey ( sort keys %usages ){
# Safety check.
next if( ! defined( $usages{"$kkey"} ) );
# Now print it out.
# Which desc should we use?
my $this_desc = &argv_meta_retrieve( $kkey, "desc" );
$this_desc = "undefined" if( ! defined( $this_desc ) );
# Assemble the print.
my @toprint_lines = ();
# pseudo print the usage.
push @toprint_lines, sprintf( " %-" . $longest . "s ", $usages{"$kkey"} );
# Work out where we need to wrap the lines.
my $length_so_far = length( $toprint_lines[0] );
my $this_index = 0;
foreach my $this_word( split( /\s+/, $this_desc ) ){
my $this_length = ( 1 + length( $this_word ) );
if( $length_so_far + $this_length > ( $cols - 4 ) ){
$this_index++;
$length_so_far = $longest + 2;
$toprint_lines[$this_index] = " " x ( $longest + 2);
}
$toprint_lines[$this_index] .= " " . $this_word;
$length_so_far += $this_length;
}
# Finally print out the lines.
foreach my $this_line( @toprint_lines ){
print "$this_line\n";
}
}
print "\n\t<file> may be a filename, or '-' for STDIN.\n\n";
exit(0);
}
##
## Display parse errors generated by argv_correct()
##
sub display_parse_errors () {
my $arg = shift;
my %opts = (@_);
if( defined( $arg ) ){
foreach my $error ( @{$opts{"$arg"}} ){
print STDERR "$0: Found error: $error\n";
}
}
}
##
## Returns the index into an array that a particular token is in the
## 'expects' argument. Assumes space seperated.
##
sub argv_meta_token_match(){
my $retval = undef;
my $kkey = shift;
my $token = shift;
my $style = &argv_behaviour();
if( defined( $argv_meta{"$kkey"} ) && defined( $token ) ){
my $expects = &argv_meta_retrieve( $kkey, "expects" );
if( defined( $expects ) ){
my @tsplit = split( /\s+/, $expects );
my $t_loop = 0;
while( ( $t_loop < scalar @tsplit ) && ( ! defined( $retval ) ) ){
# print STDERR "Attempting to match $tsplit[$t_loop] against $token\n";
if( $tsplit[$t_loop] eq $token ){
$retval = $t_loop;
}
$t_loop++;
}
}
}
return( $retval );
}
##
## Match token patterns given in the expects clause
##
sub match_patterns() {
my $template = shift;
my $tocheck = shift;
# What do things mean?
my %pat_matches = (
"<num>" => "\\d+",
"<num2>" => "\\d+",
"<text>" => "\\S+.*",
"<date>" => "\\S+.*",
"<file>" => "\\S+.*",
"<prio>" => "\\d+",
"<user>" => "\\S+",
"<numrange>" => "(\\d+|\\d+\\-|\\d+\\-\\d+|\\-\\d+)",
# "<requestor>" => "\\S+@\\S+",
"<requestor>" => "\\S+",
"<ipv4>" => "\\d+\\.\\d+\\.\\d+\\.\\d+",
"<ipv4cidr>" => "\\d+\\(.\\d+){0,3}\\/\\d+",
"<ipv6>" => "[0-9:]+", # This needs work.
"<ipv6cidr>" => "[0-9\\/:]+", # really needs work
"<domain>" => "\\S+",
);
my $retval = 0;
if( defined( $template ) && defined( $tocheck ) ){
my $res = $template;
$res =~ s/^[^<]+//g;
$res =~ s/[^>]+$//g;
# (<\S+>).*$/$1/g;
# print "res is $res from $template\n";
if( defined( $pat_matches{"$res"} ) ){
my $pat = $pat_matches{"$template"};
if( $tocheck =~ /^$pat$/ ){
$retval = 1;
}
}
}
return( $retval );
}
##
## The silly function that corrects arguments in argv after testing to
## see that we've got something reasonable for the arguments.
##
sub argv_correct(){
# Correct and find arguments in @ARGV.
# Where we are in the ARGV array.
my $argv_loop = 0; # $ARGV[0] is the program name
# maximum number of iterations through this loop that we
# permit. ( In case %argv_meta has an endless loop defined in it )
my $max_iter = ( scalar @ARGV ) + 100;
# Cache the possible arguments.
my %arg_cache = ();
my $done_cache = undef;
# Allow arguments that have been processed to skip the isvisible test
my @isok = ();
while ( ( $argv_loop < scalar @ARGV ) && ( $max_iter > 0 ) ){
# Decrement this first.
$max_iter--;
# How many arguments do we step over?
my $step_flag = 1;
# If we encounter '--', we finish right now.
# ( We're imitating GetOptions behaviour )
if( $ARGV[$argv_loop] eq "--" ){
$argv_loop = scalar @ARGV;
next;
}
# Define the variables.
my $real_arg = undef;
my $tmp_arg = undef;
# Preload the cache if required.
if( ! $done_cache ){
# Lets cache the suckers.
foreach my $kkey( keys %argv_meta ){
# print "fnord asking for $kkey\n";
$tmp_arg = &argv_meta_retrieve( $kkey, "argv" );
if( defined( $tmp_arg ) ){
$arg_cache{"$tmp_arg"} = $kkey;
}else{
$arg_cache{"--$kkey"} = $kkey;
}
}
$done_cache = 1;
}
# Check for '=' signs, and splice it into @ARGV as a
# seperate argument (we'll encounter this when we
# waltz through the expects list.
if( $ARGV[$argv_loop] =~ /^(\S+)(?<!=)(=)(\S+.*)$/ ){
my $t_arg = $1;
my $t_value = $3;
splice( @ARGV, $argv_loop, 1, $t_arg, $t_value );
# Fix up @isok (we've inserted something into @ARGV,
# thus rendering the match between @ARGV and @isok
# to be invalid. Make it match again, and casually
# mark it as suspect in @isok (undef).
splice( @isok, ( $argv_loop + 1 ), 1, undef );
}
# Now, see if this value is defined.
$tmp_arg = $arg_cache{$ARGV[$argv_loop]};
if( defined( $tmp_arg ) ){
# But only if its visible, or has been rewritten into
# something.
if( &isvisible( $tmp_arg ) || defined( $isok[$argv_loop] ) ){
$real_arg = $tmp_arg;
# $tmp_arg = undef;
}else{
# This specific option is not visible.
# need to try again.
$tmp_arg = $ARGV[$argv_loop];
$real_arg = undef;
}
}else{
# this option is completely not known. try partial.
$tmp_arg = $ARGV[$argv_loop];
$real_arg = undef;
}
# If we didn't find anything, we do a partial match.
# (I know Getopt::Long does partial matches, however, we
# need to do this in order to apply our checks on the
# expects variable)
#
if( ! defined( $real_arg ) ){
# Hrmph. We *really* have to look for this one.
# get rid of extranous '-'s.
# $tmp_arg =~ s/^-+//g;
my @matches = ();
my $keylen = length( $tmp_arg );
foreach my $kkey( keys %arg_cache ){
next if( ! &isvisible( $arg_cache{"$kkey"} ) && ! defined( $isok[$argv_loop] ) );
my $key_loop=0;
my $kkey_len = length( $kkey );
my $match=0;
# We're not going to find a partial here.
next if( $kkey_len > $keylen );
# substr is good.
my $t1 = substr( $kkey, 0, $kkey_len );
if( $t1 eq $tmp_arg ){
# Partial match worked. Its a possible
push @matches, $kkey;
}
}
if( ( scalar @matches ) == 1 ){
# We found only one match - use it.
$real_arg = pop @matches;
}else{
# We didn't find a good match. Complain about
# it, or rather, prepare a complaint about it.
# We use the hidden argument
# '__MaGiC-parse-error' for this.
splice( @ARGV, $argv_loop, 1, "--__MaGiC-parse-error", "$tmp_arg: partial search failed with " . scalar @matches . " found" );
# We want to know about this next time around.
$isok[$argv_loop] = 1;
# Fix up @isok.
splice( @isok, ( $argv_loop + 1 ), 1, undef );
$step_flag = 0;
}
}
# Paranoia check.
if( defined( $real_arg ) ){
# if our meta array is undefined for this, we really
# don't know about it.
$real_arg = undef if( ! defined( $argv_meta{"$real_arg"} ) );
}
# Make sure that we can use this argument with our current
# behaviour.
if( defined( $real_arg ) ){
$real_arg = undef if( ! &isvisible( $real_arg ) && ! defined( $isok[$argv_loop] ) );
}
# At this point, we should have a real_arg. We'll leave it
# to GetOptions to actually complain though.
# Snag our expects list.
my $expects = &argv_meta_retrieve( $real_arg, "expects" );
if( defined( $real_arg ) ){
# Lets look at what we've got, and what need rewriting
# Firstly, rewrite the current arg if the tmp_arg is
# something else.
if( $ARGV[$argv_loop] ne $real_arg ){
$ARGV[$argv_loop] = "--" . $real_arg;
}
# Easily done. Whats next?
# Look at the 'expects' argument and see if we've
# really got something.
if( defined( $expects ) ){
my @tsplit = split( /\s+/, $expects );
my $t_loop=0;
my @bad_juju=();
while( $t_loop < scalar @tsplit ){
my $t_easy = $argv_loop + $t_loop + 1;
if( defined( $ARGV[$t_easy] ) ){
# We've got something to check. Retrieve the pattern.
# print "attempting match $ARGV[$t_easy] against expected $tsplit[$t_loop]\n";
if( ! &match_patterns( $tsplit[$t_loop], $ARGV[$t_easy] ) ){
# urm, bad.
push @bad_juju, $t_loop;
}
}else{
push @bad_juju, $t_loop;
}
$t_loop++;
}
# Check that we had good data.
if( scalar @bad_juju > 0 ){
# This is like, bad.
splice( @ARGV, $argv_loop, ( scalar @tsplit + 1), ( "--__MaGiC-parse-error", "$tmp_arg: expects failed: $expects" ) );
# We want to know about this next time around.
$isok[$argv_loop] = 1;
# Fix up @isok.
splice( @isok, ( $argv_loop + 1 ), ( scalar @tsplit + 1), undef );
$real_arg=undef;
$step_flag = 0;
}else{
# We had good data.
# Advance the step flag over this.
$step_flag = $t_loop + 1;
}
}
}
# Recheck whether $real_arg is defined before we rewrite it
# ( we only rewrite it if we need to ).
if( defined( $real_arg ) ){
# Do we need to rewrite anything?
my $real = &argv_meta_retrieve( $real_arg, "real" );
if( defined( $real ) ){
# We do. I so love this bit (not).
# Grab the arguments that we probably need.
my @tsplit = ();
my @real_cache = ();
if( defined( $expects ) ){
@tsplit = split( /\s+/, $expects );
my $t_loop = 0;
while( $t_loop < scalar @tsplit ){
my $t_easy = $argv_loop + $t_loop + 1;
$real_cache[$t_loop] = $ARGV[$t_easy];
$t_loop++;
}
}
my @rsplit = split( /\s+/, $real );
# Walk through @rsplit, replacing the <tokens>
# with stuff.
my $r_loop = 0;
while( ($r_loop < scalar @rsplit) ){
if( $rsplit[$r_loop] =~ /^\s*([^<]+)?(<\S+>)(\S+)?\s*$/ ){
# This is a token. See which
# index value in @real_cache it
# actually is.
my $extra_pre = $1;
my $extra_post = $3;
my $ac_val = &argv_meta_token_match( $real_arg, $2 );
$extra_pre = "" if( ! defined( $extra_pre ) );
$extra_post = "" if( ! defined( $extra_post ) );
if( defined( $ac_val ) ){
$rsplit[$r_loop] = $extra_pre . $real_cache[$ac_val] . $extra_post;
}
}
$r_loop++;
}
# print "rsplit - @rsplit -\n";
# print "fnordpre @ARGV\n";
# Split the new stuff into the ARGV array.
splice( @ARGV, $argv_loop, ( ( scalar @real_cache ) + 1), @rsplit );
# Say that we're safe for these arguments.
my $ok_loop = 0;
while( $ok_loop < scalar @rsplit ){
$isok[$argv_loop + $ok_loop] = 1;
$ok_loop++;
}
# print "fnordpost @ARGV\n";
# Set our increment to 0.
# Since we've completely rewritten the args in
# this position, we need to rescan this
# position.
$step_flag = 0;
}
}
# Finally, increment the loop counter.
$argv_loop += $step_flag;
} # end of while argv_loop
if( $max_iter == 0 ){
# Whinge about this
splice( @ARGV, $argv_loop, 1, ( "--__MaGiC-parse-error", "endless loop found in argv_meta" ) );
}
} # end of argv_correct
# Variable for indicating our debuggedness level
my $debug_flag = 0;
sub set_debug(){
my ($opt, %opts) = (@_);
my $retval = undef;
if( $opt eq "debug" ){
$debug_flag = $opts{"$opt"} if( $opts{"$opt"} =~ /^\d+$/ );
$retval = $debug_flag;
}elsif( $opt eq "selfcheck" ){
$retval = "set_debug: complete";
}
return( $retval );
} # end of set_debug
## print a debug message. Use undef for the message to know what the level
## is.
sub debug_msg(){
my( $level, $msg) = (@_);
my $retval = undef;
if( defined( $level ) ){
if( $level =~ /^\d+$/ ){
if( $level <= $debug_flag ){
$retval = $debug_flag;
if( defined( $msg ) ){
chomp( $msg );
print STDERR "$0: $msg\n";
}
}
}
}
return( $retval );
}
my $company_name = undef;
## Sets the company name.
sub set_company() {
my ($opt, %opts) = (@_);
if( defined( $opt ) ){
if( $opt eq "company" ){
$company_name = $opts{"$opt"};
}
}
return( $company_name );
}
## Sets the domain name.
my $domain_name;
sub set_domain() {
my ($opt, %opts) = (@_);
if( defined( $opt ) ){
if( $opt eq "domain" ){
$domain_name = $opts{"$opt"};
}
}
return( $domain_name );
}
my %dates = ();
# Stores the date. No syntax checking is done.
sub set_date (){
my ($opt, %opts) = (@_);
my $retval = undef;
if( defined( $opt ) ){
if( $opt eq "start" || $opt eq "end" ){
if( %opts ){
if( defined( $opts{"$opt"} ) ){
$dates{"$opt"} = $opts{"$opt"};
}
}
$retval = $dates{"$opt"};
}
}
return( $retval );
}
my $queuename = undef;
## Store the name of the queue.
sub set_queue(){
my ($opt, %opts) = (@_);
if( defined( $opt ) ){
if( $opt eq "queue" ){
if( %opts ){
if( defined( $opts{"$opt"} ) ){
$queuename = $opts{"$opt"};
}
}
}
}
return( $queuename );
}
} # End local variable scope for %argv_meta
###############################################################################
## S U B R O U T I N E S
###############################################################################
# Routines 'warranty', 'copyright' and 'usage' are defined earlier, as part
# of the normal script template.
## This needs to be changed for your location.
sub get_mappings(){
my $filename = shift;
my %retarr = ();
my %mappy_desc = ();
if( open( GETIN, $filename ) ){
while( my $line = <GETIN> ){
chomp $line;
# 1-56206;can;Can;DB;
if( $line =~ /^\s*([\w\s]+?)\s+#[\w\d]+\s+##(.+?)\s*$/ ){
$mappy_desc{"$1"} = $2;
}elsif( $line =~ /^\s*\d\-\d{4,5}\s*\;\s*([a-z]{2,})\s*\;\s*[\w\- \.]*\s*\;\s*(.*)\s*\;\s*$/) {
$retarr{"$1"} = $2;
}
}
close( GETIN );
}
foreach my $poppy( keys %retarr ){
next unless( defined( $retarr{"$poppy"} ) );
my $val2 = $retarr{"$poppy"};
foreach my $val( split(/,/ , $val2 ) ){
next if( $val =~ /^\s*or\s*$/i );
if( defined( $mappy_desc{"$val"} ) ){
$retarr{"$poppy"} = $mappy_desc{"$val"};
}
}
}
return( %retarr );
}
## search the Users list and find all those at the domain.
sub do_match(){
my( $opt, %opts ) = (@_);
my $retval = undef;
## Don't like these, but trying to keep the indent level down.
return( $retval ) unless( defined( $opt ) );
return( $retval ) unless( $opt eq "matchfile" );
# Lets start
my %mappings = &get_mappings( $opts{"$opt"} );
my $CurrentUser = &get_rt_handle( "system" );
if( defined( $CurrentUser ) && %mappings ){
&debug_msg( 1, "do_match: Got both CurrentUser and mappings" );
my $users = new RT::Users( $CurrentUser );
# $users->UnLimit();
if( defined( &set_domain( undef ) ) ){
&debug_msg( 1, "do_match: Setting limits to " . &set_domain( undef ) );
$users->Limit( FIELD => 'EmailAddress',
VALUE => "%\@" . &set_domain( undef ),
OPERATOR => "LIKE",
);
}
while( my $user = $users->Next() ){
my $addr = $user->EmailAddress();
&debug_msg( 4, "do_match: Got $addr" );
# Try to get a match in full.
my $match = undef;
if( defined( $mappings{"$addr"} ) ){
$match = $addr;
}
# Remove the '@domain' stuff.
$addr =~ s/@.*$//g;
if( defined( $mappings{"$addr"} ) ){
$match = $addr;
}
if( defined( $match) ){
$retval++;
&debug_msg( 3, "do_match: Found match in mappings as $match" );
# Yay!
my $orgtext = undef;
if( defined( &set_company( undef ) ) ){
$orgtext = &set_company( undef );
}
if( defined( $mappings{"$match"} ) ){
if( $mappings{"$match"} !~ /^\s*$/ && defined( $orgtext ) ){
$orgtext .= " - ";
}
$orgtext .= $mappings{"$match"};
}
# Trim off excessive space.
if( ! defined( $orgtext ) ){
$orgtext = "";
}
$orgtext =~ s/\s*$//g;
my $tmporg = $user->Organization();
if( $tmporg ne $orgtext ){
$user->SetOrganization( $orgtext );
&debug_msg( 3, "do_match: Set $match to X $orgtext X from X $tmporg X" );
}
}
}
}else{
&debug_msg( 1, "do_match: Getting of one of CurrentUser or mappings failed" );
}
return( $retval );
}
## Summarise the tickets found.
sub do_summary (){
my( $opt, %opts ) = (@_);
my $retval = undef;
## Don't like these, but trying to keep the indent level down.
return( $retval ) unless( defined( $opt ) );
return( $retval ) unless( $opt eq "summary" );
my $CurrentUser = &get_rt_handle( "system" );
if( defined( $CurrentUser ) ){
## We want to get a summary for a particular domain, and
## ouput the subject lines from people with particular
## organisations.
my $orgname = &set_company( undef );
my $tickets = new RT::Tickets( $CurrentUser );
# $tickets->UnLimit();
## Apply the limits needed. They are:
## domain name of requestors.
## orgname
if( defined( &set_domain( undef ) ) || defined( &set_company( undef ) ) ){
# if( 1 == 0 ){
## Hate complicated joins.
if( defined( &set_domain( undef ) ) ){
&debug_msg( 4, "do_summary: Adding join for domain " . &set_domain( undef ) );
$tickets->LimitCreator(
FIELD => 'EmailAddress',
VALUE => "%\@" . &set_domain( undef ),
OPERATOR => "LIKE",
);
}
if( defined( &set_company( undef ) ) ){
&debug_msg( 4, "do_summary: Adding join for organisation " . &set_company( undef ) );
$tickets->LimitCreator(
FIELD => 'Organization',
VALUE => "%" . &set_company( undef ) . "%",
OPERATOR => "LIKE",
);
}
}
## Queue name.
if( defined( &set_queue( undef ) ) ){
&debug_msg( 4, "do_summary: Limiting to Queue " . &set_queue( undef ) );
my $tst_val = $tickets->LimitQueue( ALIAS => 'main',
VALUE => &set_queue( undef ),
OPERATOR => '=',
ENTRYAGGREGATOR => 'AND',
);
&debug_msg( 2, "do_summary: tst_val is $tst_val" );
}
## dates (start and end)
foreach my $ddate( "start", "end" ){
next unless defined( &set_date( $ddate ) );
&debug_msg( 4, "do_summary: Testing date $ddate" );
my $rt_date = new RT::Date( $CurrentUser );
$rt_date->Set( Format => 'unknown',
Value => &set_date( $ddate ),
);
## Set the SQL Operator.
my $op = ">=";
if( $ddate eq "end" ){
$op = "<=";
}
$tickets->LimitDate(
ALIAS => 'main',
FIELD => 'Created',
VALUE => $rt_date->ISO,
OPERATOR => $op,
ENTRYAGGREGATOR => "AND",
);
}
my $loop = 0;
# my %restrict = $tickets->DescribeRestrictions();
# foreach my $poppy( %restrict ){
# print "$poppy\n";
# }
# $tickets->RowsPerPage( 50 );
my %depts = ();
my %ticksubs = ();
my %tickcre = ();
my %tickstatus = ();
my $total_ticks = 0;
while( my $ticket = $tickets->Next() ){
&debug_msg( 3, "do_summary: Found ticket " . $ticket->id() . " with creator " . $ticket->CreatorObj->EmailAddress() . " and " . $ticket->CreatorObj->Organization() );
my $tmporg = $ticket->CreatorObj->Organization();
&debug_msg( 3, "storing " . $tmporg );
push @{$depts{$tmporg}}, $ticket->id;
$ticksubs{$ticket->id} = $ticket->Transactions->First->Subject();
$tickcre{$ticket->id} = $ticket->CreatorObj->EmailAddress();
$tickstatus{$ticket->id} = $ticket->Status();
$total_ticks++;
}
# Loop through what we found.
print "Summary for:\n";
print "\tQueue: " . &set_queue(undef) . "\n" if( defined( &set_queue(undef) ) );
print "\tDomain: " . &set_domain(undef) . "\n" if( defined( &set_domain(undef) ) );
print "\tCompany: " . &set_company(undef) . "\n" if( defined( &set_company(undef) ) );
print "\tStarting: " . &set_date("start") . "\n" if( defined( &set_date("start") ) );
print "\tEnding: " . &set_date("end") . "\n" if( defined( &set_date("end") ) );
print "\tTotal Found: $total_ticks\n";
print "\n";
foreach my $poppy( sort %depts ){
# Somehow, this gets an array reference in it.
next if( ref( $poppy ) );
printf( "%-40.40s:\t%5d\n", $poppy, scalar @{$depts{$poppy}} );
next if( $opts{$opt} eq "brief" );
my %tmparr = ();
foreach my $poppy2( @{$depts{$poppy}} ){
my $tmpval = $tickcre{$poppy2};
$tmpval =~ s/@.*$//g;
$tmpval = sprintf( "%-10.10s", $tmpval );
my $tmpval2 = "\t" . $poppy2 . " (" . sprintf( "%1.1s", $tickstatus{$poppy2} ) . ")" . "\t" . $tmpval . "\t" . $ticksubs{$poppy2} . "\n";
# print "\t" . $poppy2(" . $tickstatus{$poppy2} . ")\t" . $tmpval . "\t" . $ticksubs{$poppy2} . "\n";
push @{$tmparr{$tmpval}}, $tmpval2;
}
foreach my $poppy2( sort keys %tmparr ){
foreach my $poppy3( @{$tmparr{$poppy2}} ){
print $poppy3;
}
}
print "\n";
}
}
}
sub get_rt_handle (){
my $u_type = shift;
# Do this at runtime, not compile time (otherwise asking for '--help'
# incurs a large load as the RT libraries are loaded - ugly.
# My development box is slow - this line is visible.
print STDERR "Attempting to load RT::Interface::CLI\r";
eval {
# use lib "/usr/local/rt2/etc";
# use lib "/usr/local/rt2/lib";
use lib "/home/rt2/etc";
# use lib ".";
# use lib "lib";
use lib "/home/rt2/lib";
require RT::Interface::CLI;
require RT::Tickets;
require RT::Users;
require RT::Queue;
require RT::Date;
require DBIx::SearchBuilder;
# require RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect GetCurrentUser GetMessageContent);
};
my $retval = undef;
if( ! $@ ){
#Clean out all the nasties from the environment
RT::Interface::CLI::CleanEnv();
#Load etc/config.pm and drop privs
RT::Interface::CLI::LoadConfig();
#Connect to the database and get RT::SystemUser and
# RT::Nobody loaded
RT::Interface::CLI::DBConnect();
#Drop setgid permissions if we have them.
RT::DropSetGIDPermissions();
#Get the current user all loaded
if( defined( $u_type ) ){
if( $u_type =~ /system/ && defined( $RT::SystemUser ) ){
$retval = $RT::SystemUser;
}else{
$retval = RT::Interface::CLI::GetCurrentUser();
}
}else{
$retval = RT::Interface::CLI::GetCurrentUser();
}
}else{
print STDERR "Unable to load RT libraries. \n";
}
if( defined( $retval ) ){
print STDERR " \r";
}
return( $retval );
}
###############################################################################
## M A I N
###############################################################################
sub main(){
# Prepare for GetOptions
# For options that take list or hash values, it is necessary
# to indicate this by appending an "@" or "%" sign after the
# type:
#
# GetOptions (\%h, 'colours=s@'); # will push to @{$h{colours}}
## Correct variables in @ARGV
&argv_correct();
my %opts = ();
my @opts_array = &gen_GetOptions_array();
# print "@opts_array\n";
# print @ARGV;
my $getopt_retval = GetOptions( \%opts, @opts_array );
if( ( scalar %opts ) eq "0" ){
# No arguments defined? eek!
print STDERR "$0: An argument is expected. Try --help\n";
exit(0);
}
# Fill in default values.
&argv_supply_defaults( \%opts );
my ( $look_for, %precedence ) = &argv_precedence( join( ' ', keys %opts ) );
my @call_order = ();
# Call the subroutines defined.
foreach my $kkey( keys %opts ){
# We shortcut arguments that have precedence.
if( defined( $precedence{"$kkey"} ) ){
&debug_msg( 6, "Splicing $kkey (precedence)" );
splice( @call_order, 0, 0, $kkey );
}else{
&debug_msg( 6, "Pushing $kkey (normal)" );
push @call_order, $kkey;
}
}
$look_for = 0;
my $loop=0;
while( $loop < scalar @call_order ){
my $kkey = $call_order[$loop];
&debug_msg( 6, "Processing $kkey ( $loop of " . scalar @call_order . " )" );
$look_for++ if( defined( &argv_meta_retrieve( $kkey, "isreal" ) ) );
my $this_sub = &which_sub( $kkey );
if( defined( $this_sub ) ){
# Do this in an eval so we just don't bork.
eval { &$this_sub( $kkey, %opts ); };
if( $@ ){
print STDERR "$0: Internal error: Subroutine for \'$kkey\' does not exist or failed.\n";
print STDERR "$@\n";
}
}
$loop++;
}
if( $look_for == 0 ){
# No useful arguments defined? eek!
print STDERR "$0: An action argument is expected. Try --help\n";
exit(0);
}
}
# Invoke main.
&main();
More information about the Rt-devel
mailing list