From f4247c22a77543afa76f4bc81281bdda71f776cf Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Mar 2004 06:20:20 +0000 Subject: grey out inactive text boxes as well as disable them (IE doesn't grey out disabled text dialogs) --- httemplate/edit/svc_forward.cgi | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/httemplate/edit/svc_forward.cgi b/httemplate/edit/svc_forward.cgi index 2e6c5f1a0..2b9d35ad1 100755 --- a/httemplate/edit/svc_forward.cgi +++ b/httemplate/edit/svc_forward.cgi @@ -129,15 +129,19 @@ Service: <%= $part_svc->svc %>

function srcchanged(what) { if ( what.options[what.selectedIndex].value == 0 ) { what.form.src.disabled = false; + what.form.src.style.backgroundColor = "white"; } else { what.form.src.disabled = true; + what.form.src.style.backgroundColor = "lightgrey"; } } function dstchanged(what) { if ( what.options[what.selectedIndex].value == 0 ) { what.form.dst.disabled = false; + what.form.dst.style.backgroundColor = "white"; } else { what.form.dst.disabled = true; + what.form.dst.style.backgroundColor = "lightgrey"; } } @@ -153,7 +157,7 @@ function dstchanged(what) { <% } %> <% if ( $svc_forward->dbdef_table->column('src') ) { %> -> +> <% } %> @@ -164,7 +168,7 @@ function dstchanged(what) { <% } %> -> +>
-- cgit v1.2.1 From c65b166b6e2ebdac5c2eb2e8336ebd1a4087f77c Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Mar 2004 13:42:08 +0000 Subject: fix welcome emails being sent to signup server declined accounts, closes: Bug#743 --- FS/FS/ClientAPI/Signup.pm | 37 +++++++++++++++++++++++---- FS/FS/cust_main.pm | 64 +++++++++++++++++++++++++++++++++-------------- FS/FS/cust_pkg.pm | 3 +++ FS/FS/queue.pm | 47 +++++++++++++++++++++++++++++++--- FS/FS/svc_Common.pm | 62 ++++++++++++++++++++++++++++++++++++++------- FS/FS/svc_acct.pm | 36 +++++++++++++++++++++++--- FS/FS/svc_broadband.pm | 8 +++++- FS/FS/svc_domain.pm | 10 ++++++-- FS/FS/svc_external.pm | 60 ++++++++++++++++++++++++-------------------- FS/FS/svc_forward.pm | 10 ++++++-- FS/FS/svc_www.pm | 11 ++++++-- 11 files changed, 274 insertions(+), 74 deletions(-) diff --git a/FS/FS/ClientAPI/Signup.pm b/FS/FS/ClientAPI/Signup.pm index 375958b9c..4655b0984 100644 --- a/FS/FS/ClientAPI/Signup.pm +++ b/FS/FS/ClientAPI/Signup.pm @@ -4,6 +4,7 @@ use strict; use Tie::RefHash; use FS::Conf; use FS::Record qw(qsearch qsearchs dbdef); +use FS::Msgcat qw(gettext); use FS::agent; use FS::cust_main_county; use FS::part_pkg; @@ -12,7 +13,7 @@ use FS::cust_main; use FS::cust_pkg; use FS::svc_acct; use FS::acct_snarf; -use FS::Msgcat qw(gettext); +use FS::queue; use FS::ClientAPI; #hmm FS::ClientAPI->register_handlers( @@ -171,7 +172,8 @@ sub new_customer { my @acct_snarf; my $snarfnum = 1; - while ( length($packet->{"snarf_machine$snarfnum"}) ) { + while ( exists($packet->{"snarf_machine$snarfnum"}) + && length($packet->{"snarf_machine$snarfnum"}) ) { my $acct_snarf = new FS::acct_snarf ( { 'machine' => $packet->{"snarf_machine$snarfnum"}, 'protocol' => $packet->{"snarf_protocol$snarfnum"}, @@ -189,12 +191,28 @@ sub new_customer { $error = $svc_acct->check; return { 'error' => $error } if $error; + #setup a job dependancy to delay provisioning + my $placeholder = new FS::queue ( { + 'job' => 'FS::ClientAPI::Signup::__placeholder', + 'status' => 'locked', + } ); + $error = $placeholder->insert; + return { 'error' => $error } if $error; + use Tie::RefHash; tie my %hash, 'Tie::RefHash'; %hash = ( $cust_pkg => [ $svc_acct ] ); #msgcat - $error = $cust_main->insert( \%hash, \@invoicing_list, 'noexport' => 1 ); - return { 'error' => $error } if $error; + $error = $cust_main->insert( + \%hash, + \@invoicing_list, + 'depend_jobnum' => $placeholder->jobnum, + ); + if ( $error ) { + my $perror = $placeholder->delete; + $error .= " (Additionally, error removing placeholder: $perror)" if $perror; + return { 'error' => $error }; + } if ( $conf->exists('signup_server-realtime') ) { @@ -222,11 +240,20 @@ sub new_customer { local $FS::svc_Common::noexport_hack = 1; $cust_main->cancel('quiet'=>1); + my $perror = $placeholder->depended_delete; + warn "error removing provisioning jobs after decline: $perror" if $perror; + unless ( $perror ) { + $perror = $placeholder->delete; + warn "error removing placeholder after decline: $perror" if $perror; + } + return { 'error' => '_decline' }; } } - $cust_main->reexport; + + $error = $placeholder->delete; + return { 'error' => $error } if $error; return { error => '' }; diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 6ca32871d..a9fcb2b66 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,7 +1,7 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $Debug $import ); +use vars qw( @ISA $conf $DEBUG $import ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -42,8 +42,8 @@ use FS::Msgcat qw(gettext); $realtime_bop_decline_quiet = 0; -$Debug = 0; -#$Debug = 1; +$DEBUG = 0; +#$DEBUG = 1; $import = 0; @@ -232,10 +232,16 @@ invoicing_list destination to the newly-created svc_acct. Here's an example: $cust_main->insert( {}, [ $email, 'POST' ] ); -Currently available options are: I +Currently available options are: I and I. -If I is set true, no provisioning jobs (exports) are scheduled. -(You can schedule them later with the B method.) +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). + +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method.) =cut @@ -244,6 +250,9 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; + warn "FS::cust_main::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -295,7 +304,6 @@ sub insert { } # packages - #local $FS::svc_Common::noexport_hack = 1 if $options{'noexport'}; $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -330,7 +338,7 @@ sub insert { } -=item order_pkgs HASHREF, [ , OPTION => VALUE ... ] ] +=item order_pkgs HASHREF, [ SECONDSREF, [ , OPTION => VALUE ... ] ] Like the insert method on an existing record, this method orders a package and included services atomicaly. Pass a Tie::RefHash data structure to this @@ -343,14 +351,20 @@ be a better explanation of this, but until then, here's an example: $cust_pkg => [ $svc_acct ], ... ); - $cust_main->order_pkgs( \%hash, 'noexport'=>1 ); + $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); + +Currently available options are: I and I. -Currently available options are: I +If I is set, all provisioning jobs will have a dependancy +on the supplied jobnum (they will not run until the specific job completes). +This can be used to defer provisioning until some action completes (such +as running the customer's credit card sucessfully). -If I is set true, no provisioning jobs (exports) are scheduled. -(You can schedule them later with the B method for each -cust_pkg object. Using the B method on the cust_main object is not -recommended, as existing services will also be reexported.) +The I option is deprecated. If I is set true, no +provisioning jobs (exports) are scheduled. (You can schedule them later with +the B method for each cust_pkg object. Using the B method +on the cust_main object is not recommended, as existing services will also be +reexported.) =cut @@ -359,6 +373,12 @@ sub order_pkgs { my $cust_pkgs = shift; my $seconds = shift; my %options = @_; + my %svc_options = (); + $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} + if exists $options{'depend_jobnum'}; + warn "FS::cust_main::order_pkgs called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -386,7 +406,7 @@ sub order_pkgs { $svc_something->seconds( $svc_something->seconds + $$seconds ); $$seconds = 0; } - $error = $svc_something->insert; + $error = $svc_something->insert(%svc_options); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting svc_ (transaction rolled back): $error"; @@ -401,6 +421,9 @@ sub order_pkgs { =item reexport +This method is deprecated. See the I option to the insert and +order_pkgs methods for a better way to defer provisioning. + Re-schedules all exports by calling the B method of all associated packages (see L). If there is an error, returns the error; otherwise returns false. @@ -410,6 +433,9 @@ otherwise returns false. sub reexport { my $self = shift; + carp "warning: FS::cust_main::reexport is deprectated; ". + "use the depend_jobnum option to insert or order_pkgs to delay export"; + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -1474,7 +1500,7 @@ sub collect { my $dbh = dbh; my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $Debug; + warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1500,7 +1526,7 @@ sub collect { last if $self->balance <= 0; warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" - if $Debug; + if $DEBUG; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds @@ -1521,7 +1547,7 @@ sub collect { || $self->balance <= 0; # or if balance<=0 warn "calling invoice event (". $part_bill_event->eventcode. ")\n" - if $Debug; + if $DEBUG; my $cust_main = $self; #for callback my $error; @@ -1659,7 +1685,7 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; - if ( $Debug ) { + if ( $DEBUG ) { warn "$self $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; } diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index c2182118f..d60e95b78 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -669,6 +669,9 @@ sub transfer { =item reexport +This method is deprecated. See the I option to the insert and +order_pkgs methods in FS::cust_main for a better way to defer provisioning. + =cut sub reexport { diff --git a/FS/FS/queue.pm b/FS/FS/queue.pm index 634f7f4bd..9dcb2e3be 100644 --- a/FS/FS/queue.pm +++ b/FS/FS/queue.pm @@ -1,7 +1,7 @@ package FS::queue; use strict; -use vars qw( @ISA @EXPORT_OK $conf $jobnums); +use vars qw( @ISA @EXPORT_OK $DEBUG $conf $jobnums); use Exporter; use FS::UID; use FS::Conf; @@ -14,6 +14,9 @@ use FS::cust_svc; @ISA = qw(FS::Record); @EXPORT_OK = qw( joblisting ); +$DEBUG = 0; +#$DEBUG = 1; + $FS::UID::callback{'FS::queue'} = sub { $conf = new FS::Conf; }; @@ -120,7 +123,10 @@ sub insert { } } - push @$jobnums, $self->jobnum if $jobnums; + if ( $jobnums ) { + warn "jobnums global is active: $jobnums\n" if $DEBUG; + push @$jobnums, $self->jobnum; + } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -239,6 +245,7 @@ sub cust_svc { =item queue_depend Returns the FS::queue_depend objects associated with this job, if any. +(Dependancies that must complete before this job can be run). =cut @@ -247,7 +254,6 @@ sub queue_depend { qsearch('queue_depend', { 'jobnum' => $self->jobnum } ); } - =item depend_insert OTHER_JOBNUM Inserts a dependancy for this job - it will not be run until the other job @@ -268,6 +274,39 @@ sub depend_insert { $queue_depend->insert; } +=item queue_depended + +Returns the FS::queue_depend objects that associate other jobs with this job, +if any. (The jobs that are waiting for this job to complete before they can +run). + +=cut + +sub queue_depended { + my $self = shift; + qsearch('queue_depend', { 'depend_jobnum' => $self->jobnum } ); +} + +=item depended_delete + +Deletes the other queued jobs (FS::queue objects) that are waiting for this +job, if any. If there is an error, returns the error, otherwise returns false. + +=cut + +sub depended_delete { + my $self = shift; + my $error; + foreach my $job ( + map { qsearchs('queue', { 'jobnum' => $_->jobnum } ) } $self->queue_depended + ) { + $error = $job->depended_delete; + return $error if $error; + $error = $job->delete; + return $error if $error + } +} + =back =head1 SUBROUTINES @@ -385,7 +424,7 @@ END =head1 VERSION -$Id: queue.pm,v 1.16 2003-08-05 00:20:46 khoff Exp $ +$Id: queue.pm,v 1.17 2004-03-03 13:42:08 ivan Exp $ =head1 BUGS diff --git a/FS/FS/svc_Common.pm b/FS/FS/svc_Common.pm index a154f3f85..a22326696 100644 --- a/FS/FS/svc_Common.pm +++ b/FS/FS/svc_Common.pm @@ -1,7 +1,7 @@ package FS::svc_Common; use strict; -use vars qw( @ISA $noexport_hack ); +use vars qw( @ISA $noexport_hack $DEBUG ); use FS::Record qw( qsearch qsearchs fields dbh ); use FS::cust_svc; use FS::part_svc; @@ -9,6 +9,9 @@ use FS::queue; @ISA = qw( FS::Record ); +$DEBUG = 0; +#$DEBUG = 1; + =head1 NAME FS::svc_Common - Object method for all svc_ records @@ -82,7 +85,7 @@ sub check { $self->SUPER::check; } -=item insert [ JOBNUM_ARRAYREF [ OBJECTS_ARRAYREF ] ] +=item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -90,19 +93,36 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. -If an arrayref is passed as parameter, the Bs of any export jobs will -be added to the array. +Currently available options are: I, I and +I. + +If I is set to an array reference, the jobnums of any export jobs will +be added to the referenced array. + +If I is set to an array reference of FS::tablename objects (for +example, FS::acct_snarf objects), they will have their svcnum fieldsset and +will be inserted after this record, but before any exports are run. -If an arrayref of FS::tablename objects (for example, FS::acct_snarf objects) -is passed as the optional second parameter, they will have their svcnum fields -set and will be inserted after this record, but before any exports are run. +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). =cut sub insert { my $self = shift; - local $FS::queue::jobnums = shift if @_; - my $objects = scalar(@_) ? shift : []; + my %options = @_; + warn "FS::svc_Common::insert called with options ". + join(', ', map { "$_: $options{$_}" } keys %options ). "\n" + if $DEBUG; + + my @jobnums = (); + local $FS::queue::jobnums = \@jobnums; + warn "FS::svc_Common::insert: set \$FS::queue::jobnums to $FS::queue::jobnums" + if $DEBUG; + my $objects = $options{'child_objects'} || []; + my $depend_jobnums = $options{'depend_jobnum'} || []; + $depend_jobnums = [ $depend_jobnums ] unless ref($depend_jobnums); my $error; local $SIG{HUP} = 'IGNORE'; @@ -162,6 +182,10 @@ sub insert { #new-style exports! unless ( $noexport_hack ) { + + warn "FS::svc_Common::insert: \$FS::queue::jobnums is $FS::queue::jobnums" + if $DEBUG; + foreach my $part_export ( $self->cust_svc->part_svc->part_export ) { my $error = $part_export->export_insert($self); if ( $error ) { @@ -170,6 +194,26 @@ sub insert { " (transaction rolled back): $error"; } } + + foreach my $depend_jobnum ( @$depend_jobnums ) { + warn "inserting dependancies on supplied job $depend_jobnum\n" + if $DEBUG; + foreach my $jobnum ( @jobnums ) { + my $queue = qsearchs('queue', { 'jobnum' => $jobnum } ); + warn "inserting dependancy for job $jobnum on $depend_jobnum\n" + if $DEBUG; + my $error = $queue->depend_insert($depend_jobnum); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error queuing job dependancy: $error"; + } + } + } + + } + + if ( exists $options{'jobnums'} ) { + push @{ $options{'jobnums'} }, @jobnums; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 32d87202e..d84240f36 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -33,6 +33,7 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::svc_Common ); $DEBUG = 0; +#$DEBUG = 1; $me = '[FS::svc_acct]'; #ask FS::UID to run this stuff for us later @@ -176,7 +177,7 @@ Creates a new account. To add the account to the database, see L<"insert">. sub table { 'svc_acct'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this account to the database. If there is an error, returns the error, otherwise returns false. @@ -193,15 +194,21 @@ should contain an arrayref of FS::tablename objects. They will have their svcnum fields set and will be inserted after this record, but before any exports are run. +Currently available options are: I + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). + (TODOC: L and L) (TODOC: new exports!) - =cut sub insert { my $self = shift; + my %options = @_; my $error; local $SIG{HUP} = 'IGNORE'; @@ -325,7 +332,11 @@ sub insert { #see? i told you it was more complicated my @jobnums; - $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] ); + $error = $self->SUPER::insert( + 'jobnums' => \@jobnums, + 'child_objects' => $self->child_objects, + %options, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -395,6 +406,22 @@ sub insert { return "error queuing welcome email: $error"; } + if ( $options{'depend_jobnum'} ) { + warn "$me depend_jobnum found; adding to welcome email dependancies" + if $DEBUG; + if ( ref($options{'depend_jobnum'}) ) { + warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ). + "to welcome email dependancies" + if $DEBUG; + push @jobnums, @{ $options{'depend_jobnum'} }; + } else { + warn "$me adding job $options{'depend_jobnum'} ". + "to welcome email dependancies" + if $DEBUG; + push @jobnums, $options{'depend_jobnum'}; + } + } + foreach my $jobnum ( @jobnums ) { my $error = $wqueue->depend_insert($jobnum); if ( $error ) { @@ -1264,6 +1291,9 @@ counterintuitive. radius_usergroup_selector? putting web ui components in here? they should probably live somewhere else... +insertion of RADIUS group stuff in insert could be done with child_objects now +(would probably clean up export of them too) + =head1 SEE ALSO L, edit/part_svc.cgi from an installed web interface, diff --git a/FS/FS/svc_broadband.pm b/FS/FS/svc_broadband.pm index 77898066d..aaac891e6 100755 --- a/FS/FS/svc_broadband.pm +++ b/FS/FS/svc_broadband.pm @@ -87,7 +87,7 @@ points to. You can ask the object for a copy with the I method. sub table { 'svc_broadband'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -95,6 +95,12 @@ otherwise returns false. The additional fields pkgnum and svcpart (see FS::cust_svc) should be defined. An FS::cust_svc record will be created and inserted. +Currently available options are: I + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). + =cut # Standard FS::svc_Common::insert diff --git a/FS/FS/svc_domain.pm b/FS/FS/svc_domain.pm index 10d5d8f5c..c88b3e668 100644 --- a/FS/FS/svc_domain.pm +++ b/FS/FS/svc_domain.pm @@ -86,7 +86,7 @@ Creates a new domain. To add the domain to the database, see L<"insert">. sub table { 'svc_domain'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this domain to the database. If there is an error, returns the error, otherwise returns false. @@ -112,6 +112,12 @@ If any records are defined in the I configuration file, appropriate records are added to the domain_record table (see L). +Currently available options are: I + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). + =cut sub insert { @@ -145,7 +151,7 @@ sub insert { return "Domain not found (see whois)"; } - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/svc_external.pm b/FS/FS/svc_external.pm index fe4ea1d67..b97e12b47 100644 --- a/FS/FS/svc_external.pm +++ b/FS/FS/svc_external.pm @@ -69,7 +69,7 @@ points to. You can ask the object for a copy with the I method. sub table { 'svc_external'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this external service to the database. If there is an error, returns the error, otherwise returns false. @@ -77,17 +77,23 @@ error, otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. -=cut +Currently available options are: I -sub insert { - my $self = shift; - my $error; +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). - $error = $self->SUPER::insert; - return $error if $error; +=cut - ''; -} +#sub insert { +# my $self = shift; +# my $error; +# +# $error = $self->SUPER::insert(@_); +# return $error if $error; +# +# ''; +#} =item delete @@ -95,15 +101,15 @@ Delete this record from the database. =cut -sub delete { - my $self = shift; - my $error; - - $error = $self->SUPER::delete; - return $error if $error; - - ''; -} +#sub delete { +# my $self = shift; +# my $error; +# +# $error = $self->SUPER::delete; +# return $error if $error; +# +# ''; +#} =item replace OLD_RECORD @@ -113,15 +119,15 @@ returns the error, otherwise returns false. =cut -sub replace { - my ( $new, $old ) = ( shift, shift ); - my $error; - - $error = $new->SUPER::replace($old); - return $error if $error; - - ''; -} +#sub replace { +# my ( $new, $old ) = ( shift, shift ); +# my $error; +# +# $error = $new->SUPER::replace($old); +# return $error if $error; +# +# ''; +#} =item suspend diff --git a/FS/FS/svc_forward.pm b/FS/FS/svc_forward.pm index b9e8ff8f7..b8d55fecb 100644 --- a/FS/FS/svc_forward.pm +++ b/FS/FS/svc_forward.pm @@ -68,7 +68,7 @@ database, see L<"insert">. sub table { 'svc_forward'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this mail forwarding alias to the database. If there is an error, returns the error, otherwise returns false. @@ -76,6 +76,12 @@ the error, otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. +Currently available options are: I + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). + =cut sub insert { @@ -96,7 +102,7 @@ sub insert { $error = $self->check; return $error if $error; - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; diff --git a/FS/FS/svc_www.pm b/FS/FS/svc_www.pm index 7e8908346..6c276a198 100644 --- a/FS/FS/svc_www.pm +++ b/FS/FS/svc_www.pm @@ -74,7 +74,7 @@ points to. You can ask the object for a copy with the I method. sub table { 'svc_www'; } -=item insert +=item insert [ , OPTION => VALUE ... ] Adds this record to the database. If there is an error, returns the error, otherwise returns false. @@ -82,6 +82,13 @@ otherwise returns false. The additional fields pkgnum and svcpart (see L) should be defined. An FS::cust_svc record will be created and inserted. +Currently available options are: I + +If I is set (to a scalar jobnum or an array reference of +jobnums), all provisioning jobs will have a dependancy on the supplied +jobnum(s) (they will not run until the specific job(s) complete(s)). + + =cut sub insert { @@ -124,7 +131,7 @@ sub insert { $self->recnum($domain_record->recnum); } - $error = $self->SUPER::insert; + $error = $self->SUPER::insert(@_); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; -- cgit v1.2.1 From 24b5d695250eb0e93d50f35d0fa46776223d2a68 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 3 Mar 2004 16:32:08 +0000 Subject: fix for case where no .fetchmailrc should be create and fetchmail should not be run --- bin/create-fetchmailrc | 2 ++ 1 file changed, 2 insertions(+) diff --git a/bin/create-fetchmailrc b/bin/create-fetchmailrc index e92971140..11bde0ce3 100644 --- a/bin/create-fetchmailrc +++ b/bin/create-fetchmailrc @@ -22,6 +22,8 @@ my $filename = "$homedir/.fetchmailrc"; my $gid = scalar(getgrnam($username)) or die "can't find $username's gid\n"; my $uid = scalar(getpwnam($username)) or die "can't find $username's uid\n"; +exit unless $ARGV[0]; + open(FETCHMAILRC, ">$filename") or die "can't open $filename: $!\n"; chown $uid, $gid, $filename or die "can't chown $uid.$gid $filename: $!\n"; chmod 0600, $filename or die "can't chmod 600 $filename: $!\n"; -- cgit v1.2.1 From 1b15d4bbb47875129b8da15331b118a6ad6727f3 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Mar 2004 05:59:16 +0000 Subject: fix -v --- FS/bin/freeside-daily | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/FS/bin/freeside-daily b/FS/bin/freeside-daily index 5fb966665..00de2987a 100755 --- a/FS/bin/freeside-daily +++ b/FS/bin/freeside-daily @@ -16,7 +16,7 @@ my $user = shift or die &usage; adminsuidsetup $user; -$FS::cust_main::Debug = 1 if $opt_v; +$FS::cust_main::DEBUG = 1 if $opt_v; my %search; $search{'payby'} = $opt_p if $opt_p; -- cgit v1.2.1 From 654234a526b5447ec02970962cccb1cf879796c8 Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 5 Mar 2004 14:34:24 +0000 Subject: beginning of OO reporting interface, create acadia-requested crosstab reports --- FS/FS/Report.pm | 46 ++++++++++ FS/FS/Report/Table.pm | 27 ++++++ FS/FS/Report/Table/Monthly.pm | 166 ++++++++++++++++++++++++++++++++++ FS/MANIFEST | 6 ++ FS/t/Report-Table-Monthly.t | 5 + FS/t/Report-Table.t | 5 + FS/t/Report.t | 5 + htetc/global.asa | 1 + htetc/handler.pl | 1 + httemplate/graph/money_time-graph.cgi | 116 ++++++++---------------- httemplate/graph/money_time.cgi | 60 +++++++++++- 11 files changed, 356 insertions(+), 82 deletions(-) create mode 100644 FS/FS/Report.pm create mode 100644 FS/FS/Report/Table.pm create mode 100644 FS/FS/Report/Table/Monthly.pm create mode 100644 FS/t/Report-Table-Monthly.t create mode 100644 FS/t/Report-Table.t create mode 100644 FS/t/Report.t diff --git a/FS/FS/Report.pm b/FS/FS/Report.pm new file mode 100644 index 000000000..181fea2f6 --- /dev/null +++ b/FS/FS/Report.pm @@ -0,0 +1,46 @@ +package FS::Report; + +use strict; + +=head1 NAME + +FS::Report - Report data objects + +=head1 SYNOPSIS + + #see the more speicific report objects, currently only FS::Report::Table + +=head1 DESCRIPTION + +See the more specific report objects, currently only FS::Report::Table + +=head1 METHODS + +=over 4 + +=item new [ OPTION => VALUE ... ] + +Constructor. Takes a list of options and their values. + +=cut + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = @_ ? ( ref($_[0]) ? shift : { @_ } ) : {}; + bless( $self, $class ); +} + +=back + +=head1 BUGS + +Documentation. + +=head1 SEE ALSO + +L, reports in the web interface. + +=cut + +1; diff --git a/FS/FS/Report/Table.pm b/FS/FS/Report/Table.pm new file mode 100644 index 000000000..9f636fa43 --- /dev/null +++ b/FS/FS/Report/Table.pm @@ -0,0 +1,27 @@ +package FS::Report::Table; + +use strict; +use vars qw( @ISA ); +use FS::Report; + +@ISA = qw( FS::Report ); + +=head1 NAME + +FS::Report::Table - Tables of report data + +=head1 SYNOPSIS + +See the more specific report objects, currently only FS::Report::Table::Monthly + +=head1 BUGS + +Documentation. + +=head1 SEE ALSO + +L, reports in the web interface. + +=cut + +1; diff --git a/FS/FS/Report/Table/Monthly.pm b/FS/FS/Report/Table/Monthly.pm new file mode 100644 index 000000000..9aebeee3d --- /dev/null +++ b/FS/FS/Report/Table/Monthly.pm @@ -0,0 +1,166 @@ +package FS::Report::Table::Monthly; + +use strict; +use vars qw( @ISA ); +use Time::Local; +use FS::UID qw( dbh ); +use FS::Report::Table; + +@ISA = qw( FS::Report::Table ); + +=head1 NAME + +FS::Report::Table::Monthly - Tables of report data, indexed monthly + +=head1 SYNOPSIS + + use FS::Report::Table::Monthly; + + my $report = new FS::Report::Table ( + 'items' => [ 'invoiced', 'netsales', 'credits', 'receipts', ], + 'start_month' => 4, + 'start_year' => 2000, + 'end_month' => 4, + 'end_year' => 2020, + ); + + my $data = $report->data; + +=head1 METHODS + +=over 4 + +=item data + +Returns a hashref of data (!! describe) + +=cut + +sub data { + my $self = shift; + + my $smonth = $self->{'start_month'}; + my $syear = $self->{'start_year'}; + my $emonth = $self->{'end_month'}; + my $eyear = $self->{'end_year'}; + + my %data; + + while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth+1 ) ) { + + push @{$data{label}}, "$smonth/$syear"; + + my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); + if ( ++$smonth == 13 ) { $syear++; $smonth=1; } + my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); + + foreach my $item ( @{$self->{'items'}} ) { + push @{$data{$item}}, $self->$item($speriod, $eperiod); + } + + } + + \%data; + +} + +sub invoiced { #invoiced + my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); + $self->scalar_sql(" + SELECT SUM(charged) FROM cust_bill + WHERE ". $self->in_time_period($speriod, $eperiod) + ); +} + +sub netsales { #net sales + my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); + + my $credited = $self->scalar_sql(" + SELECT SUM(cust_credit_bill.amount) + FROM cust_credit_bill, cust_bill + WHERE cust_bill.invnum = cust_credit_bill.invnum + AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill') + ); + + #horrible local kludge + my $expenses = $self->scalar_sql(" + SELECT SUM(cust_bill_pkg.setup) + FROM cust_bill_pkg, cust_bill, cust_pkg, part_pkg + WHERE cust_bill.invnum = cust_bill_pkg.invnum + AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill'). " + AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum + AND cust_pkg.pkgpart = part_pkg.pkgpart + AND LOWER(part_pkg.pkg) LIKE 'expense _%' + "); + + $self->invoiced($speriod,$eperiod)-$credited-$expenses; +} + +#deferred revenue + +sub receipts { #cashflow + my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); + + #cashflow + my $paid = $self->scalar_sql(" + SELECT SUM(paid) FROM cust_pay + WHERE ". $self->in_time_period($speriod, $eperiod) + ); + + my $refunded = $self->scalar_sql(" + SELECT SUM(refund) FROM cust_refund + WHERE ". $self->in_time_period($speriod, $eperiod) + ); + + #horrible local kludge that doesn't even really work right + my $expenses = $self->scalar_sql(" + SELECT SUM(cust_bill_pay.amount) + FROM cust_bill_pay, cust_bill + WHERE cust_bill_pay.invnum = cust_bill.invnum + AND ". $self->in_time_period($speriod, $eperiod, 'cust_bill_pay'). " + AND 0 < ( SELECT COUNT(*) from cust_bill_pkg, cust_pkg, part_pkg + WHERE cust_bill.invnum = cust_bill_pkg.invnum + AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum + AND cust_pkg.pkgpart = part_pkg.pkgpart + AND LOWER(part_pkg.pkg) LIKE 'expense _%' + ) + "); + # my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; + + $paid-$refunded-$expenses; +} + +sub credits { + my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); + $self->scalar_sql(" + SELECT SUM(amount) FROM cust_credit + WHERE ". $self->in_time_period($speriod, $eperiod) + ); +} + +sub in_time_period { + my( $self, $speriod, $eperiod ) = ( shift, shift, shift ); + my $table = @_ ? shift().'.' : ''; + "${table}_date >= $speriod AND ${table}_date < $eperiod"; +} + +sub scalar_sql { + my( $self, $sql ) = ( shift, shift ); + my $sth = dbh->prepare($sql) or die dbh->errstr; + $sth->execute + or die "Unexpected error executing statement $sql: ". $sth->errstr; + $sth->fetchrow_arrayref->[0] || 0; +} + +=back + +=head1 BUGS + +Documentation. + +=head1 SEE ALSO + +=cut + +1; + diff --git a/FS/MANIFEST b/FS/MANIFEST index 3cbf0e91f..555509a41 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -37,6 +37,9 @@ FS/Conf.pm FS/ConfItem.pm FS/Misc.pm FS/Record.pm +FS/Report.pm +FS/Report/Table.pm +FS/Report/Table/Monthly.pm FS/SearchCache.pm FS/UI/Base.pm FS/UI/CGI.pm @@ -128,6 +131,9 @@ t/Conf.t t/ConfItem.t t/Misc.t t/Record.t +t/Report.pm +t/Report-Table.pm +t/Report-Table-Monthly.pm t/UID.t t/Msgcat.t t/SearchCache.t diff --git a/FS/t/Report-Table-Monthly.t b/FS/t/Report-Table-Monthly.t new file mode 100644 index 000000000..6ff365d1c --- /dev/null +++ b/FS/t/Report-Table-Monthly.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report::Table::Monthly; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Report-Table.t b/FS/t/Report-Table.t new file mode 100644 index 000000000..866d4981e --- /dev/null +++ b/FS/t/Report-Table.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report::Table; +$loaded=1; +print "ok 1\n"; diff --git a/FS/t/Report.t b/FS/t/Report.t new file mode 100644 index 000000000..76d6ea489 --- /dev/null +++ b/FS/t/Report.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::Report; +$loaded=1; +print "ok 1\n"; diff --git a/htetc/global.asa b/htetc/global.asa index 8027ae3e5..5652a6f4f 100644 --- a/htetc/global.asa +++ b/htetc/global.asa @@ -24,6 +24,7 @@ use FS::CGI qw(header menubar popurl table itable ntable idiot eidiot small_custview myexit http_header); use FS::Msgcat qw(gettext geterror); use FS::Misc qw( send_email ); +use FS::Report::Table::Monthly; use FS::agent; use FS::agent_type; diff --git a/htetc/handler.pl b/htetc/handler.pl index 618c5856f..0301d98d1 100644 --- a/htetc/handler.pl +++ b/htetc/handler.pl @@ -81,6 +81,7 @@ sub handler small_custview myexit http_header); use FS::Msgcat qw(gettext geterror); use FS::Misc qw( send_email ); + use FS::Report::Table::Monthly; use FS::agent; use FS::agent_type; diff --git a/httemplate/graph/money_time-graph.cgi b/httemplate/graph/money_time-graph.cgi index 76f1bd7bd..55e8982b4 100755 --- a/httemplate/graph/money_time-graph.cgi +++ b/httemplate/graph/money_time-graph.cgi @@ -10,98 +10,56 @@ my $smonth = $cgi->param('smonth') || $curmon+1; #find last month my $eyear = $cgi->param('eyear') || 1900+$curyear; my $emonth = $cgi->param('emonth') || $curmon+1; -if ( $emonth++>12 ) { $emonth-=12; $eyear++; } +#if ( $emonth++>12 ) { $emonth-=12; $eyear++; } -my @labels; -my %data; +#my @labels; +#my %data; -while ( $syear < $eyear || ( $syear == $eyear && $smonth < $emonth ) ) { - push @labels, "$smonth/$syear"; - - my $speriod = timelocal(0,0,0,1,$smonth-1,$syear); - if ( ++$smonth == 13 ) { $syear++; $smonth=1; } - my $eperiod = timelocal(0,0,0,1,$smonth-1,$syear); - - my $where = "WHERE _date >= $speriod AND _date < $eperiod"; - - # Invoiced - my $charged_sql = "SELECT SUM(charged) FROM cust_bill $where"; - my $charged_sth = dbh->prepare($charged_sql) or die dbh->errstr; - $charged_sth->execute or die $charged_sth->errstr; - my $charged = $charged_sth->fetchrow_arrayref->[0] || 0; - - push @{$data{charged}}, $charged; - - #accounts receivable -# my $ar_sql2 = "SELECT SUM(amount) FROM cust_credit $where"; - my $credited_sql = "SELECT SUM(cust_credit_bill.amount) FROM cust_credit_bill, cust_bill WHERE cust_bill.invnum = cust_credit_bill.invnum AND cust_bill._date >= $speriod AND cust_bill._date < $eperiod"; - my $credited_sth = dbh->prepare($credited_sql) or die dbh->errstr; - $credited_sth->execute or die $credited_sth->errstr; - my $credited = $credited_sth->fetchrow_arrayref->[0] || 0; - - #horrible local kludge - my $expenses_sql = "SELECT SUM(cust_bill_pkg.setup) FROM cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill._date >= $speriod AND cust_bill._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; - my $expenses_sth = dbh->prepare($expenses_sql) or die dbh->errstr; - $expenses_sth->execute or die $expenses_sth->errstr; - my $expenses = $expenses_sth->fetchrow_arrayref->[0] || 0; - - push @{$data{ar}}, $charged-$credited-$expenses; - - #deferred revenue -# push @{$data{defer}}, '0'; - - #cashflow - my $paid_sql = "SELECT SUM(paid) FROM cust_pay $where"; - my $paid_sth = dbh->prepare($paid_sql) or die dbh->errstr; - $paid_sth->execute or die $paid_sth->errstr; - my $paid = $paid_sth->fetchrow_arrayref->[0] || 0; - - my $refunded_sql = "SELECT SUM(refund) FROM cust_refund $where"; - my $refunded_sth = dbh->prepare($refunded_sql) or die dbh->errstr; - $refunded_sth->execute or die $refunded_sth->errstr; - my $refunded = $refunded_sth->fetchrow_arrayref->[0] || 0; - - #horrible local kludge that doesn't even really work right - my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND 0 < ( select count(*) from cust_bill_pkg, cust_pkg, part_pkg WHERE cust_bill.invnum = cust_bill_pkg.invnum AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%' )"; - -# my $expenses_sql2 = "SELECT SUM(cust_bill_pay.amount) FROM cust_bill_pay, cust_bill_pkg, cust_bill, cust_pkg, part_pkg WHERE cust_bill_pay.invnum = cust_bill.invnum AND cust_bill.invnum = cust_bill_pkg.invnum AND cust_bill_pay._date >= $speriod AND cust_bill_pay._date < $eperiod AND cust_pkg.pkgnum = cust_bill_pkg.pkgnum AND cust_pkg.pkgpart = part_pkg.pkgpart AND LOWER(part_pkg.pkg) LIKE 'expense _%'"; - my $expenses_sth2 = dbh->prepare($expenses_sql2) or die dbh->errstr; - $expenses_sth2->execute or die $expenses_sth2->errstr; - my $expenses2 = $expenses_sth2->fetchrow_arrayref->[0] || 0; - - push @{$data{cash}}, $paid-$refunded-$expenses2; +my @items = qw( invoiced netsales credits receipts ); +my %label = ( + 'invoiced' => 'Gross Sales (invoiced)', + 'netsales' => 'Net Sales (invoiced - applied credits)', + 'credits' => 'Credits', + 'receipts' => 'Receipts/Cashflow (payments - refunds)', +); +my %color = ( + 'invoiced' => [ 153, 153, 255 ], #light blue + 'netsales' => [ 0, 0, 204 ], #blue + 'credits' => [ 204, 0, 0 ], #red + 'receipts' => [ 0, 204, 0 ], #green +); -} +my $report = new FS::Report::Table::Monthly ( + 'items' => \@items, + 'start_month' => $smonth, + 'start_year' => $syear, + 'end_month' => $emonth, + 'end_year' => $eyear, +); +my %data = %{$report->data}; #my $chart = Chart::LinesPoints->new(1024,480); -my $chart = Chart::LinesPoints->new(768,480); +#my $chart = Chart::LinesPoints->new(768,480); +my $chart = Chart::LinesPoints->new(976,384); +my $d = 0; $chart->set( #'min_val' => 0, 'legend' => 'bottom', - 'legend_labels' => [ #'Invoiced (cust_bill)', - 'Accounts receivable (invoices - applied credits)', - #'Deferred revenue', - 'Actual cashflow (payments - refunds)' ], + 'colors' => { ( map { 'dataset'.$d++ => $color{$_} } @items ), + #'grey_background' => [ 211, 211, 211 ], + 'grey_background' => 'white', + 'background' => [ 0xe8, 0xe8, 0xe8 ], #grey + }, + #'grey_background' => 'false', + 'legend_labels' => [ map { $label{$_} } @items ], + 'brush_size' => 4, + #'pt_size' => 12, ); -my @data = ( \@labels, - #map $data{$_}, qw( ar defer cash ) - #map $data{$_}, qw( charged ar cash ) - map $data{$_}, qw( ar cash ) - ); - -#my $gd = $chart->plot(\@data); -#open (IMG, ">i_r_c.png"); -#print IMG $gd->png; -#close IMG; - -#$chart->png("i_r_c.png", \@data); - -#$chart->cgi_png(\@data); +my @data = map { $data{$_} } ( 'label', @items ); http_header('Content-Type' => 'image/png' ); -#$Response->{ContentType} = 'image/png'; $chart->_set_colors(); diff --git a/httemplate/graph/money_time.cgi b/httemplate/graph/money_time.cgi index de8f6ee0c..14af0f246 100644 --- a/httemplate/graph/money_time.cgi +++ b/httemplate/graph/money_time.cgi @@ -19,9 +19,63 @@ my $emonth = $cgi->param('emonth') || $curmon+1; Graphing monetary values over time - + +
+ +<%= table('e8e8e8') %> +<% + +my @items = qw( invoiced netsales credits receipts ); +my %label = ( + 'invoiced' => 'Gross Sales', + 'netsales' => 'Net Sales', + 'credits' => 'Credits', + 'receipts' => 'Receipts', +); +my %color = ( + 'invoiced' => '9999ff', #light blue + 'netsales' => '0000cc', #blue + 'credits' => 'cc0000', #red + 'receipts' => '00cc00', #green +); + +my $report = new FS::Report::Table::Monthly ( + 'items' => \@items, + 'start_month' => $smonth, + 'start_year' => $syear, + 'end_month' => $emonth, + 'end_year' => $eyear, +); +my $data = $report->data; + + +my @mon = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); + +%> + + +<% foreach my $column ( @{$data->{label}} ) { + #$column =~ s/^(\d+)\//$mon[$1-1]
/e; + $column =~ s/^(\d+)\//$mon[$1-1]
/; + %> + <%= $column %> +<% } %> + + +<% foreach my $row (@items) { %> + <%= $label{$row} %> + <% foreach my $column ( @{$data->{$row}} ) { %> + + $<%= sprintf("%.2f", $column) %> + + <% } %> + +<% } %> + +
+ From <% } %> - +
-- cgit v1.2.1 From ecf4288cc6d98a4916128c5e45d515e0fbea09fd Mon Sep 17 00:00:00 2001 From: ivan Date: Sat, 6 Mar 2004 00:57:40 +0000 Subject: doc --- httemplate/docs/upgrade10.html | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/httemplate/docs/upgrade10.html b/httemplate/docs/upgrade10.html index 774babb9e..45efbe23b 100644 --- a/httemplate/docs/upgrade10.html +++ b/httemplate/docs/upgrade10.html @@ -1,7 +1,9 @@
 this is incomplete
 
-install DBIx::DBSchema 0.22
+install DBIx::DBSchema 0.23
+install Net::SSH 0.08
+- If using Apache::ASP, add PerlSetVar RequestBinaryRead Off to your Apache configuration and make sure you are using Apache::ASP minimum version 2.55. 
 
 install NetAddr::IP, Chart::Base, IPC::ShareLite and Locale::SubCountry
 
-- 
cgit v1.2.1


From 6f2e2ea05362732731d08bc2fdeb26946fa4d3bc Mon Sep 17 00:00:00 2001
From: khoff 
Date: Wed, 10 Mar 2004 02:37:23 +0000
Subject: UI cleanup.

---
 httemplate/browse/router.cgi | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/httemplate/browse/router.cgi b/httemplate/browse/router.cgi
index feee4ecaa..4eee96167 100644
--- a/httemplate/browse/router.cgi
+++ b/httemplate/browse/router.cgi
@@ -20,16 +20,20 @@ my $p2 = popurl(2);
   
 <% foreach my $router (sort {$a->routernum <=> $b->routernum} @router) {
      my @addr_block = $router->addr_block;
+     if (scalar(@addr_block) == 0) {
+       push @addr_block, ' ';
+     }
 %>
   
-    
+    
       <%=$router->routername%>
     
-    
-    <% foreach my $block ( @addr_block ) { %>
-      <%=$block->NetAddr%>
- <% } %> - + + <% foreach my $block ( @addr_block ) { %> + + <%=UNIVERSAL::isa($block, 'FS::addr_block') ? $block->NetAddr : ' '%> + + <% } %> <% } %> -- cgit v1.2.1 From 432a10eb5431f3ef973f6273539b2a685f665807 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 10 Mar 2004 19:06:21 +0000 Subject: Added hide/show customer router link. --- httemplate/browse/router.cgi | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/httemplate/browse/router.cgi b/httemplate/browse/router.cgi index 4eee96167..149db4903 100644 --- a/httemplate/browse/router.cgi +++ b/httemplate/browse/router.cgi @@ -11,7 +11,21 @@ my $p2 = popurl(2);

<% } %> -Add a new router

+<% +my $hidecustomerrouters = 0; +my $hideurl = ''; +if ($cgi->param('hidecustomerrouters') eq '1') { + $hidecustomerrouters = 1; + $cgi->param('hidecustomerrouters', 0); + $hideurl = 'Show customer routers'; +} else { + $hidecustomerrouters = 0; + $cgi->param('hidecustomerrouters', 1); + $hideurl = 'Hide customer routers'; +} +%> + +Add a new router | <%=$hideurl%> <%=table()%> @@ -19,6 +33,7 @@ my $p2 = popurl(2); Address block(s) <% foreach my $router (sort {$a->routernum <=> $b->routernum} @router) { + next if $hidecustomerrouters && $router->svcnum; my @addr_block = $router->addr_block; if (scalar(@addr_block) == 0) { push @addr_block, ' '; -- cgit v1.2.1 From 2c524f7421185a517faa561d8429c2a163abc2a9 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 10 Mar 2004 21:45:48 +0000 Subject: adding preliminary suse install script --- install/redhat/9/INSTALL | 6 ++++-- install/suse/INSTALL | 11 +++++++++++ 2 files changed, 15 insertions(+), 2 deletions(-) create mode 100644 install/suse/INSTALL diff --git a/install/redhat/9/INSTALL b/install/redhat/9/INSTALL index ee3cba9ee..b9a345807 100644 --- a/install/redhat/9/INSTALL +++ b/install/redhat/9/INSTALL @@ -24,11 +24,13 @@ rpm -i apache-1.3.28-0.n0i.i386.rpm apt-get install perl-CGI perl-CPAN perl-DBD-MySQL perl-DBD-Pg perl-DBI perl-DateManip perl-HTML-Parser perl-HTML-Tagset perl-TimeDate perl-URI perl-libwww-perl perl-suidperl rsync postgresql postgresql-docs postgresql-libs postgresql-server screen zsh lftp cvs gcc gd #openssh -wget --passive-ftp --continue http://atrpms.physik.fu-berlin.de/dist/rh9/perl-GD/perl-GD-2.11-7.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-45-1.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/yum/yum-2.0.4-28.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/gd/gd-2.0.15-1_6.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-package-config-45-1.rh9.at.noarch.rpm +#wget --passive-ftp --continue http://atrpms.physik.fu-berlin.de/dist/rh9/perl-GD/perl-GD-2.11-7.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-45-1.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/yum/yum-2.0.4-28.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/gd/gd-2.0.15-1_6.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-package-config-45-1.rh9.at.noarch.rpm +wget --passive-ftp --continue http://atrpms.physik.fu-berlin.de/dist/rh9/perl-GD/perl-GD-2.11-7.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-50-1.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/yum/yum-2.0.5-1_30.rh9.at.noarch.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/gd/gd-2.0.15-1_6.rh9.at.i386.rpm http://atrpms.physik.fu-berlin.de/dist/rh9/atrpms/atrpms-package-config-50-1.rh9.at.noarch.rpm cp /etc/apt/apt.conf /etc/apt/apt.conf.real -rpm -i --replacefiles atrpms-package-config-45-1.rh9.at.noarch.rpm yum-2.0.4-28.rh9.at.noarch.rpm atrpms-45-1.rh9.at.noarch.rpm gd-2.0.15-1_6.rh9.at.i386.rpm perl-GD-2.11-7.rh9.at.i386.rpm +#rpm -i --replacefiles atrpms-package-config-45-1.rh9.at.noarch.rpm yum-2.0.4-28.rh9.at.noarch.rpm atrpms-45-1.rh9.at.noarch.rpm gd-2.0.15-1_6.rh9.at.i386.rpm perl-GD-2.11-7.rh9.at.i386.rpm +rpm -i --replacefiles atrpms-package-config-50-1.rh9.at.noarch.rpm yum-2.0.5-1_30.rh9.at.noarch.rpm atrpms-50-1.rh9.at.noarch.rpm gd-2.0.15-1_6.rh9.at.i386.rpm perl-GD-2.11-7.rh9.at.i386.rpm mv /etc/apt/apt.conf.real /etc/apt/apt.conf diff --git a/install/suse/INSTALL b/install/suse/INSTALL new file mode 100644 index 000000000..85e392461 --- /dev/null +++ b/install/suse/INSTALL @@ -0,0 +1,11 @@ +#!/bin/sh + +# based on install/redhat/9/INSTALL + +# apt for SuSE howto: http://linux01.gwdg.de/apt4rpm/ + +for file in ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-libs-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/lua-5.0-rb3.i586.rpm; do + curl -C - $file +done + + -- cgit v1.2.1 From 659be703171be796aa1e38647a262385414e9933 Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 10 Mar 2004 21:47:13 +0000 Subject: move to versioned dir --- install/suse/9.0/INSTALL | 11 +++++++++++ install/suse/INSTALL | 11 ----------- 2 files changed, 11 insertions(+), 11 deletions(-) create mode 100644 install/suse/9.0/INSTALL delete mode 100644 install/suse/INSTALL diff --git a/install/suse/9.0/INSTALL b/install/suse/9.0/INSTALL new file mode 100644 index 000000000..85e392461 --- /dev/null +++ b/install/suse/9.0/INSTALL @@ -0,0 +1,11 @@ +#!/bin/sh + +# based on install/redhat/9/INSTALL + +# apt for SuSE howto: http://linux01.gwdg.de/apt4rpm/ + +for file in ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-libs-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/lua-5.0-rb3.i586.rpm; do + curl -C - $file +done + + diff --git a/install/suse/INSTALL b/install/suse/INSTALL deleted file mode 100644 index 85e392461..000000000 --- a/install/suse/INSTALL +++ /dev/null @@ -1,11 +0,0 @@ -#!/bin/sh - -# based on install/redhat/9/INSTALL - -# apt for SuSE howto: http://linux01.gwdg.de/apt4rpm/ - -for file in ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/apt-libs-0.5.5cnc6-rb6.i586.rpm ftp://ftp.gwdg.de/pub/linux/suse/apt/SuSE/9.0-i386/RPMS.suser-rbos/lua-5.0-rb3.i586.rpm; do - curl -C - $file -done - - -- cgit v1.2.1 From 557b6397be9c5a92985b0cbac849e9dd72c54b43 Mon Sep 17 00:00:00 2001 From: khoff Date: Wed, 10 Mar 2004 22:27:39 +0000 Subject: Excluded virtual fields weren't being properly masked on errors. The router/block select box wasn't being generated on errors. --- httemplate/edit/svc_broadband.cgi | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/httemplate/edit/svc_broadband.cgi b/httemplate/edit/svc_broadband.cgi index db27b3241..9e064c5c8 100644 --- a/httemplate/edit/svc_broadband.cgi +++ b/httemplate/edit/svc_broadband.cgi @@ -11,11 +11,11 @@ use Tie::IxHash; my( $svcnum, $pkgnum, $svcpart, $part_svc, $svc_broadband ); if ( $cgi->param('error') ) { $svc_broadband = new FS::svc_broadband ( { - map { $_, scalar($cgi->param($_)) } fields('svc_broadband') + map { $_, scalar($cgi->param($_)) } fields('svc_broadband'), qw(svcpart) } ); $svcnum = $svc_broadband->svcnum; $pkgnum = $cgi->param('pkgnum'); - $svcpart = $cgi->param('svcpart'); + $svcpart = $svc_broadband->svcpart; $part_svc=qsearchs('part_svc',{'svcpart'=>$svcpart}); die "No part_svc entry!" unless $part_svc; } else { @@ -132,7 +132,9 @@ Service #<%=$svcnum ? $svcnum : "(NEW)"%>

/ - - Links - --limit-member-of= - --limit-has-member= - --limit-refers-to= - --limit-referred-to-by= - --limit-depends-on= - --limit-depended-on-by= +sub list { + my ($q, $type, %data, $orderby); + my $bad = 0; + while (@ARGV) { + $_ = shift @ARGV; - Dates - --limit-created=[starts][-][ends] - --limit-due=[starts][-][ends] - --limit-starts=[starts][-][ends] - --limit-started=[starts][-][ends] - --limit-resolved=[starts][-][ends] - --limit-last-updated=[starts][-][ends] - starts and ends are dates. starts can not be less than ends + if (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-o$/) { + $orderby = shift @ARGV; + } + elsif (/^-([isl])$/) { + $data{format} = $1; + } + elsif (/^-f$/) { + if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { + whine "No valid field list in '-f $ARGV[0]'."; + $bad = 1; last; + } + $data{fields} = shift @ARGV; + } + elsif (!defined $q && !/^-/) { + $q = $_; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } - --limit-first= - --limit-rows= + $type ||= "ticket"; + unless ($type && defined $q) { + my $item = $type ? "query string" : "object type"; + whine "No $item specified."; + $bad = 1; + } + return help("list", $type) if $bad; - --history | --show - show a history of the tickets found - + my $r = submit("$REST/search/$type", { query => $q, %data, orderby => $orderby || "" }); + print $r->content; +} - --summary [format-string] - show a listing-style summary of the tickets found. If format string - is ommitted, uses \$RT_SUMMARY_FORMAT or an internal default - +# Displays selected information about a single object. - #TODO: doc summary - format: % - atom: - size: - name: (grep for # {{{ attribs for the array of ok values) +sub show { + my ($type, @objects, %data); + my $slurped = 0; + my $bad = 0; + while (@ARGV) { + $_ = shift @ARGV; - --create - create a new ticket. Any attributes that you can modify on an existing ticket - can also be used for ticket creation. + if (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-([isl])$/) { + $data{format} = $1; + } + elsif (/^-$/ && !$slurped) { + chomp(my @lines = ); + foreach (@lines) { + unless (is_object_spec($_, $type)) { + whine "Invalid object on STDIN: '$_'."; + $bad = 1; last; + } + push @objects, $_; + } + $slurped = 1; + } + elsif (/^-f$/) { + if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) { + whine "No valid field list in '-f $ARGV[0]'."; + $bad = 1; last; + } + $data{fields} = shift @ARGV; + } + elsif (my $spec = is_object_spec($_, $type)) { + push @objects, $spec; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } + unless (@objects) { + whine "No objects specified."; + $bad = 1; + } + return help("show", $type) if $bad; + my $r = submit("$REST/show", { id => \@objects, %data }); + print $r->content; +} -Attributes - Basics - --status= - sets status - --subject= - sets subject - --owner= - set owner to - --steal - Become the owner, even if someone else owns the ticket - --queue= - set queue to - - --priority= - - --final-priority= +# To create a new object, we ask the server for a form with the defaults +# filled in, allow the user to edit it, and send the form back. +# +# To edit an object, we must ask the server for a form representing that +# object, make changes requested by the user (either on the command line +# or interactively via $EDITOR), and send the form back. + +sub edit { + my ($action) = @_; + my (%data, $type, @objects); + my ($cl, $text, $edit, $input, $output); + + use vars qw(%set %add %del); + %set = %add = %del = (); + my $slurped = 0; + my $bad = 0; + + while (@ARGV) { + $_ = shift @ARGV; + + if (/^-e$/) { $edit = 1 } + elsif (/^-i$/) { $input = 1 } + elsif (/^-o$/) { $output = 1 } + elsif (/^-t$/) { + $bad = 1, last unless defined($type = get_type_argument()); + } + elsif (/^-S$/) { + $bad = 1, last unless get_var_argument(\%data); + } + elsif (/^-$/ && !($slurped || $input)) { + chomp(my @lines = ); + foreach (@lines) { + unless (is_object_spec($_, $type)) { + whine "Invalid object on STDIN: '$_'."; + $bad = 1; last; + } + push @objects, $_; + } + $slurped = 1; + } + elsif (/^set$/i) { + my $vars = 0; + + while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/) { + my ($key, $op, $val) = ($1, $2, $3); + my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del; + + vpush($hash, lc $key, $val); + shift @ARGV; + $vars++; + } + unless ($vars) { + whine "No variables to set."; + $bad = 1; last; + } + $cl = $vars; + } + elsif (/^(?:add|del)$/i) { + my $vars = 0; + my $hash = ($_ eq "add") ? \%add : \%del; + + while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/) { + my ($key, $val) = ($1, $2); + + vpush($hash, lc $key, $val); + shift @ARGV; + $vars++; + } + unless ($vars) { + whine "No variables to set."; + $bad = 1; last; + } + $cl = $vars; + } + elsif (my $spec = is_object_spec($_, $type)) { + push @objects, $spec; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } - Watchers - --requestors=[+|-] - add or remove this user as a ticket requestor - --cc=[+|-] - add or remove this user as a ticket cc - --admincc=[+|-] - add or remove this user as a ticket admincc + if ($action =~ /^ed(?:it)?$/) { + unless (@objects) { + whine "No objects specified."; + $bad = 1; + } + } + else { + if (@objects) { + whine "You shouldn't specify objects as arguments to $action."; + $bad = 1; + } + unless ($type) { + whine "What type of object do you want to create?"; + $bad = 1; + } + @objects = ("$type/new"); + } + return help($action, $type) if $bad; - (When creating tickets, just leave off the + or - ) + # We need a form to make changes to. We usually ask the server for + # one, but we can avoid that if we are fed one on STDIN, or if the + # user doesn't want to edit the form by hand, and the command line + # specifies only simple variable assignments. - Keywords - --keywords[+|-]/ - Add or remove a keyword. + if ($input) { + local $/ = undef; + $text = ; + } + elsif ($edit || %add || %del || !$cl) { + my $r = submit("$REST/show", { id => \@objects, format => 'l' }); + $text = $r->content; + } + # If any changes were specified on the command line, apply them. + if ($cl) { + if ($text) { + # We're updating forms from the server. + my $forms = Form::parse($text); + + foreach my $form (@$forms) { + my ($c, $o, $k, $e) = @$form; + my ($key, $val); + + next if ($e || !@$o); + + local %add = %add; + local %del = %del; + local %set = %set; + + # Make changes to existing fields. + foreach $key (@$o) { + if (exists $add{lc $key}) { + $val = delete $add{lc $key}; + vpush($k, $key, $val); + $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/; + } + if (exists $del{lc $key}) { + $val = delete $del{lc $key}; + my %val = map {$_=>1} @{ vsplit($val) }; + $k->{$key} = vsplit($k->{$key}); + @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}}; + } + if (exists $set{lc $key}) { + $k->{$key} = delete $set{lc $key}; + } + } + + # Then update the others. + foreach $key (keys %set) { vpush($k, $key, $set{$key}) } + foreach $key (keys %add) { + vpush($k, $key, $add{$key}); + $k->{$key} = vsplit($k->{$key}); + } + push @$o, (keys %add, keys %set); + } + + $text = Form::compose($forms); + } + else { + # We're rolling our own set of forms. + my @forms; + foreach (@objects) { + my ($type, $ids, $args) = + m{^($name)/($idlist|$labels)(?:(/.*))?$}o; + + $args ||= ""; + foreach my $obj (expand_list($ids)) { + my %set = (%set, id => "$type/$obj$args"); + push @forms, ["", [keys %set], \%set]; + } + } + $text = Form::compose(\@forms); + } + } + if ($output) { + print $text; + exit; + } - Dates - --due= - --starts= - --started= - --contacted= + my $synerr = 0; - --time-left= - - --time-taken= +EDIT: + # We'll let the user edit the form before sending it to the server, + # unless we have enough information to submit it non-interactively. + if ($edit || (!$input && !$cl)) { + my $newtext = vi($text); + # We won't resubmit a bad form unless it was changed. + $text = ($synerr && $newtext eq $text) ? undef : $newtext; + } + if ($text) { + my $r = submit("$REST/edit", {content => $text, %data}); + if ($r->code == 409) { + # If we submitted a bad form, we'll give the user a chance + # to correct it and resubmit. + if ($edit || (!$input && !$cl)) { + $text = $r->content; + $synerr = 1; + goto EDIT; + } + else { + print $r->content; + exit -1; + } + } + print $r->content; + } +} - Link related manipulation: +# We roll "comment" and "correspond" into the same handler. - --depends-on=[+|-] - --member-of=[+|-] - --refers-to=[+|-] - --merge-into= +sub comment { + my ($action) = @_; + my (%data, $id, @files, @bcc, @cc, $msg, $wtime, $edit); + my $bad = 0; -Comments and replies + while (@ARGV) { + $_ = shift @ARGV; - --comment - --reply|respond - --source - Specify the path to the source file for this ticket update + if (/^-e$/) { + $edit = 1; + } + elsif (/^-[abcmw]$/) { + unless (@ARGV) { + whine "No argument specified with $_."; + $bad = 1; last; + } + + if (/-a/) { + unless (-f $ARGV[0] && -r $ARGV[0]) { + whine "Cannot read attachment: '$ARGV[0]'."; + exit -1; + } + push @files, shift @ARGV; + } + elsif (/-([bc])/) { + my $a = $_ eq "-b" ? \@bcc : \@cc; + @$a = split /\s*,\s*/, shift @ARGV; + } + elsif (/-m/) { $msg = shift @ARGV } + elsif (/-w/) { $wtime = shift @ARGV } + } + elsif (!$id && m|^(?:ticket/)?($idlist)$|) { + $id = $1; + } + else { + my $datum = /^-/ ? "option" : "argument"; + whine "Unrecognised $datum '$_'."; + $bad = 1; last; + } + } - --noedit - Don't invoke \$EDITOR to edit the content of this update + unless ($id) { + whine "No object specified."; + $bad = 1; + } + return help($action, "ticket") if $bad; + + my $form = [ + "", + [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Text" ], + { + Ticket => $id, + Action => $action, + Cc => [ @cc ], + Bcc => [ @bcc ], + Attachment => [ @files ], + TimeWorked => $wtime || '', + Text => $msg || '', + } + ]; + + my $text = Form::compose([ $form ]); + + if ($edit || !$msg) { + my $error = 0; + my ($c, $o, $k, $e); + + do { + my $ntext = vi($text); + exit if ($error && $ntext eq $text); + $text = $ntext; + $form = Form::parse($text); + $error = 0; + + ($c, $o, $k, $e) = @{ $form->[0] }; + if ($e) { + $error = 1; + $c = "# Syntax error."; + goto NEXT; + } + elsif (!@$o) { + exit; + } + @files = @{ vsplit($k->{Attachment}) }; + + NEXT: + $text = Form::compose([[$c, $o, $k, $e]]); + } while ($error); + } + my $i = 1; + foreach my $file (@files) { + $data{"attachment_$i"} = bless([ $file ], "Attachment"); + $i++; + } + $data{content} = $text; + my $r = submit("$REST/ticket/comment/$id", \%data); + print $r->content; +} +# Merge one ticket into another. - Condiments +sub merge { + my @id; + my $bad = 0; - --verbose - --debug - --version - --help|h|usage - You're reading it. + while (@ARGV) { + $_ = shift @ARGV; -EOUSAGE + if (/^\d+$/) { + push @id, $_; + } + else { + whine "Unrecognised argument: '$_'."; + $bad = 1; last; + } + } - exit(0); -} + unless (@id == 2) { + my $evil = @id > 2 ? "many" : "few"; + whine "Too $evil arguments specified."; + $bad = 1; + } + return help("merge", "ticket") if $bad; -# Print version, and leave -if ($version) { - print "RT $RT::VERSION for $RT::rtname. Copyright 1996-2001 Jesse Vincent \n"; - exit(0); + my $r = submit("$REST/ticket/merge/$id[0]", {into => $id[1]}); + print $r->content; } -# }}} - -# {{{ Validate any options that were passed in. normalize them. +# Link one ticket to another. -#if a queue was specified -if ($queue) { - # make sure that $queue is a valid queue and load it into $queue_obj -} +sub link { + my ($bad, $del, %data) = (0, 0, ()); + my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo + ReferredToBy HasMember MemberOf); -#For each date in: $due, $starts, $started + while (@ARGV && $ARGV[0] =~ /^-/) { + $_ = shift @ARGV; -# load up an RT::Date object and parse it into a normalized form -# if it can't parse it, log an error and null out the variable + if (/^-d$/) { + $del = 1; + } + else { + whine "Unrecognised option: '$_'."; + $bad = 1; last; + } + } -# }}} + if (@ARGV == 3) { + my ($from, $rel, $to) = @ARGV; + if ($from !~ /^\d+$/ || $to !~ /^\d+$/) { + my $bad = $from =~ /^\d+$/ ? $to : $from; + whine "Invalid ticket ID '$bad' specified."; + $bad = 1; + } + unless (exists $ltypes{lc $rel}) { + whine "Invalid relationship '$rel' specified."; + $bad = 1; + } + %data = (id => $from, rel => $rel, to => $to, del => $del); + } + else { + my $bad = @ARGV < 3 ? "few" : "many"; + whine "Too $bad arguments specified."; + $bad = 1; + } + return help("link", "ticket") if $bad; -# {{{ Check if we're creating, if so, create the ticket and be done + my $r = submit("$REST/ticket/link", \%data); + print $r->content; +} -if ($create) { - $RT::Logger->debug("Creating a new ticket"); +# Grant/revoke a user's rights. - #Make sure the current user can create tickets in this queue - - #Make sure that the owner specified can own tickets in this queue +sub grant { + my ($cmd) = @_; + my $revoke = 0; + while (@ARGV) { + } - - my $linesref = GetMessageContent( Edit => $edit, Source => $source, - CurrentUser => $CurrentUser - ); - - require MIME::Entity; - my $MIMEObj; - - if ($linesref) { - $MIMEObj = MIME::Entity->build(Data => $linesref); - } - - use RT::Ticket; - my $Ticket=new RT::Ticket($CurrentUser); - my ($ticket, $trans, $msg) = - $Ticket->Create(Queue => $queue, - Owner => $owner, - Status => $status || 'new' , - Subject => $subject, - Requestor => \@requestors, - Cc => \@cc, - AdminCc => \@admincc, - Due => $due, - Starts => $starts, - Started => $started, - TimeLeft => $time_left, - InitialPriority => $priority, - FinalPriority => $final_priority, - MIMEObj => $MIMEObj - ); - print $msg . "\n"; + $revoke = 1 if $cmd->{action} eq 'revoke'; } -# }}} - -else { - #Apply restrictions - use RT::Tickets; - my $Tickets = new RT::Tickets($CurrentUser); - - # {{{ Limit our search - my $value; #to use when iterating through restrictions - my $queue_id; #to use when limiting by keyword - - # {{{ limit on id - - foreach $value (@id) { - if ($value =~ /^(\d+)$/) { - $Tickets->LimitId ( VALUE => $1, - OPERATOR => '='); - } - elsif ($value =~ /^(\d*)\D?(\d*)$/) { - my $start = $1; - my $end = $2; - $Tickets->LimitId( - VALUE => "$start", - OPERATOR => '>=') if ($start); - $Tickets->LimitId( - VALUE => "$end", - OPERATOR => '<=') if ($end); - } +# Client <-> Server communication. +# -------------------------------- +# +# This function composes and sends an HTTP request to the RT server, and +# interprets the response. It takes a request URI, and optional request +# data (a string, or a reference to a set of key-value pairs). + +sub submit { + my ($uri, $content) = @_; + my ($req, $data); + my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1); + + # Did the caller specify any data to send with the request? + $data = []; + if (defined $content) { + unless (ref $content) { + # If it's just a string, make sure LWP handles it properly. + # (By pretending that it's a file!) + $content = [ content => [undef, "", Content => $content] ]; + } + elsif (ref $content eq 'HASH') { + my @data; + foreach my $k (keys %$content) { + if (ref $content->{$k} eq 'ARRAY') { + foreach my $v (@{ $content->{$k} }) { + push @data, $k, $v; + } + } + else { push @data, $k, $content->{$k} } + } + $content = \@data; + } + $data = $content; } + # Should we send authentication information to start a new session? + if (!defined $session->cookie) { + push @$data, ( user => $config{user} ); + push @$data, ( pass => $config{passwd} || read_passwd() ); + } - # }}} - - # {{{ limit on status - - foreach $value (@limit_status) { - if ($value =~ /^(=|!=|!|)(.*)$/) { - my $op = $1; - my $val = $2; - - - $op = ParseBooleanOp($op); - $Tickets->LimitStatus(VALUE => "$val", - OPERATOR => "$op"); - } + # Now, we construct the request. + if (@$data) { + $req = POST($uri, $data, Content_Type => 'form-data'); } + else { + $req = GET($uri); + } + $session->add_cookie_header($req); + + # Then we send the request and parse the response. + DEBUG(3, $req->as_string); + my $res = $ua->request($req); + DEBUG(3, $res->as_string); + + if ($res->is_success) { + # The content of the response we get from the RT server consists + # of an HTTP-like status line followed by optional header lines, + # a blank line, and arbitrary text. + + my ($head, $text) = split /\n\n/, $res->content, 2; + my ($status, @headers) = split /\n/, $head; + $text =~ s/\n*$/\n/; + + # "RT/3.0.1 401 Credentials required" + if ($status !~ m#^RT/\d+(?:\.\d+)+(?:-?\w+)? (\d+) ([\w\s]+)$#) { + warn "rt: Malformed RT response from $config{server}.\n"; + warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3; + exit -1; + } - # }}} - - - - # {{{ limit on queue - foreach $value (@limit_queue) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - - my $queue_obj = new RT::Queue($RT::SystemUser); - - unless ($queue_obj->Load($val)) { - $RT::Logger->debug("Queue '$val' not found"); - print STDERR "Queue '$val' not found\n"; - exit(-1); - } - $RT::Logger->debug ("Limiting queue to $op ".$queue_obj->Name); - $Tickets->LimitQueue(VALUE => $queue_obj->Name, - OPERATOR => $op); - $queue_id=$queue_obj->id; - } - } - - # {{{ limit on keyword - foreach $value (@limit_keyword) { - if ($value =~ /^(\W?)(.*?)\/(.*)$/i) { - my $op = $1; - my $select = $2; - my $keyword = $3; - - $op = ParseBooleanOp($op); - - # load the keyword select - my $keyselect = RT::KeywordSelect->new($RT::SystemUser); - unless ($keyselect->LoadByName(Name=>$select, Queue=>$queue_id)) { - $RT::Logger->debug("KeywordSelect '$select' not found"); - print STDERR "KeywordSelect '$select' not fount\n"; - exit(-1); - } - - # load the keyword - my $k = RT::Keyword->new($RT::SystemUser); - unless ($k->LoadByNameAndParentId($keyword, $keyselect->Keyword)) { - $RT::Logger->debug("Keyword '$keyword' not found"); - print STDERR "Keyword '$keyword' not found\n"; - exit(-1); - } - $Tickets->LimitKeyword(OPERATOR => $op, - KEYWORDSELECT => $keyselect->id, - KEYWORD => $k->id); - $RT::Logger->debug ("Limiting keyword to $op ".$k->Path); - } + # Our caller can pretend that the server returned a custom HTTP + # response code and message. (Doing that directly is apparently + # not sufficiently portable and uncomplicated.) + $res->code($1); + $res->message($2); + $res->content($text); + $session->update($res) if ($res->is_success || $res->code != 401); + + if (!$res->is_success) { + # We can deal with authentication failures ourselves. Either + # we sent invalid credentials, or our session has expired. + if ($res->code == 401) { + my %d = @$data; + if (exists $d{user}) { + warn "rt: Incorrect username or password.\n"; + exit -1; + } + elsif ($req->header("Cookie")) { + # We'll retry the request with credentials, unless + # we only wanted to logout in the first place. + $session->delete; + return submit(@_) unless $uri eq "$REST/logout"; + } + } + # Conflicts should be dealt with by the handler and user. + # For anything else, we just die. + elsif ($res->code != 409) { + warn "rt: ", $res->content; + exit; + } + } } - # }}} - # {{{ limit on owner - foreach $value (@limit_owner) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - - my $user_obj = new RT::User($RT::SystemUser); - - unless ($user_obj->Load($val)) { - $RT::Logger->debug("User '$val' not found"); - print STDERR "User '$val' not found\n"; - exit(-1); - } - $val = $user_obj->id(); - - $RT::Logger->debug ("Limiting owner to $op $val"); - $Tickets->LimitOwner(VALUE => "$val", - OPERATOR => "$op"); - } - } - # }}} - # {{{ limt on priority - - foreach $value (@limit_priority) { - my ($start, $end) = ParseRange($value); - if ($start == $end) { - $Tickets->LimitPriority( VALUE => $start, - OPERATOR => '='); - } elsif ($start) { - $Tickets->LimitPriority( VALUE => $start, - OPERATOR => '>='); - } elsif ($end) { - $Tickets->LimitPriority( VALUE => $end, - OPERATOR => '<='); - } - + else { + warn "rt: Server error: ", $res->message, " (", $res->code, ")\n"; + exit -1; } - foreach $value (@limit_final_priority) { - my ($start, $end) = ParseRange($value); - if ($start == $end) { - $Tickets->LimitFinalPriority( VALUE => $start, - OPERATOR => '='); - } elsif ($start) { - $Tickets->LimitFinalPriority( VALUE => $start, - OPERATOR => '>='); - } elsif ($end) { - $Tickets->LimitFinalPriority( VALUE => $end, - OPERATOR => '<='); - } + + return $res; +} + +# Session management. +# ------------------- +# +# Maintains a list of active sessions in the ~/.rt_sessions file. +{ + package Session; + my ($s, $u); + + # Initialises the session cache. + sub new { + my ($class, $file) = @_; + my $self = { + file => $file || "$HOME/.rt_sessions", + sids => { } + }; + + # The current session is identified by the currently configured + # server and user. + ($s, $u) = @config{"server", "user"}; + + bless $self, $class; + $self->load(); + + return $self; } - # }}} - - foreach $value (@limit_requestor) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseBooleanOp($op); - $Tickets->LimitRequestor(VALUE => $val, - OPERATOR => $op ); - } - + + # Returns the current session cookie. + sub cookie { + my ($self) = @_; + my $cookie = $self->{sids}{$s}{$u}; + return defined $cookie ? "RT_SID=$cookie" : undef; } - foreach $value (@limit_subject) { - - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseLikeOp($op); - - $Tickets->LimitSubject(VALUE => $val, - OPERATOR => $op ); - } + + # Deletes the current session cookie. + sub delete { + my ($self) = @_; + delete $self->{sids}{$s}{$u}; } - - foreach $value (@limit_body) { - if ($value =~ /^(\W?)(.*?)$/i) { - my $op = $1; - my $val = $2; - - $op = ParseLikeOp($op); - - $Tickets->LimitBody(VALUE => $val, - OPERATOR => $op ); - } - + + # Adds a Cookie header to an outgoing HTTP request. + sub add_cookie_header { + my ($self, $request) = @_; + my $cookie = $self->cookie(); + + $request->header(Cookie => $cookie) if defined $cookie; } - - - - # Dates - foreach my $date (@limit_created) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitCreated ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitCreated ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + + # Extracts the Set-Cookie header from an HTTP response, and updates + # session information accordingly. + sub update { + my ($self, $response) = @_; + my $cookie = $response->header("Set-Cookie"); + + if (defined $cookie && $cookie =~ /^RT_SID=([0-9A-Fa-f]+);/) { + $self->{sids}{$s}{$u} = $1; + } } - foreach my $date (@limit_due) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitDue ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitDue ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + # Loads the session cache from the specified file. + sub load { + my ($self, $file) = @_; + $file ||= $self->{file}; + local *F; + + open(F, $file) && do { + $self->{file} = $file; + my $sids = $self->{sids} = {}; + while () { + chomp; + next if /^$/ || /^#/; + next unless m#^https?://[^ ]+ \w+ [0-9A-Fa-f]+$#; + my ($server, $user, $cookie) = split / /, $_; + $sids->{$server}{$user} = $cookie; + } + return 1; + }; + return 0; } - foreach my $date (@limit_starts) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitStarts ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitStarts ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + # Writes the current session cache to the specified file. + sub save { + my ($self, $file) = shift; + $file ||= $self->{file}; + local *F; + + open(F, ">$file") && do { + my $sids = $self->{sids}; + foreach my $server (keys %$sids) { + foreach my $user (keys %{ $sids->{$server} }) { + my $sid = $sids->{$server}{$user}; + if (defined $sid) { + print F "$server $user $sid\n"; + } + } + } + close(F); + chmod 0600, $file; + return 1; + }; + return 0; } - foreach my $date (@limit_started) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitStarted ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitStarted ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + sub DESTROY { + my $self = shift; + $self->save; } +} - foreach my $date (@limit_resolved) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitResolved ( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitResolved ( VALUE => $end, - OPERATOR => '<=' ) if ($end); +# Form handling. +# -------------- +# +# Forms are RFC822-style sets of (field, value) specifications with some +# initial comments and interspersed blank lines allowed for convenience. +# Sets of forms are separated by --\n (in a cheap parody of MIME). +# +# Each form is parsed into an array with four elements: commented text +# at the start of the form, an array with the order of keys, a hash with +# key/value pairs, and optional error text if the form syntax was wrong. + +# Returns a reference to an array of parsed forms. +sub Form::parse { + my $state = 0; + my @forms = (); + my @lines = split /\n/, $_[0]; + my ($c, $o, $k, $e) = ("", [], {}, ""); + + LINE: + while (@lines) { + my $line = shift @lines; + + next LINE if $line eq ''; + + if ($line eq '--') { + # We reached the end of one form. We'll ignore it if it was + # empty, and store it otherwise, errors and all. + if ($e || $c || @$o) { + push @forms, [ $c, $o, $k, $e ]; + $c = ""; $o = []; $k = {}; $e = ""; + } + $state = 0; + } + elsif ($state != -1) { + if ($state == 0 && $line =~ /^#/) { + # Read an optional block of comments (only) at the start + # of the form. + $state = 1; + $c = $line; + while (@lines && $lines[0] =~ /^#/) { + $c .= "\n".shift @lines; + } + $c .= "\n"; + } + elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) { + # Read a field: value specification. + my $f = $1; + my @v = ($2 || ()); + + # Read continuation lines, if any. + while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) { + push @v, shift @lines; + } + pop @v while (@v && $v[-1] eq ''); + + # Strip longest common leading indent from text. + my $ws = ""; + foreach my $ls (map {/^(\s+)/} @v[1..$#v]) { + $ws = $ls if (!$ws || length($ls) < length($ws)); + } + s/^$ws// foreach @v; + + push(@$o, $f) unless exists $k->{$f}; + vpush($k, $f, join("\n", @v)); + + $state = 1; + } + elsif ($line !~ /^#/) { + # We've found a syntax error, so we'll reconstruct the + # form parsed thus far, and add an error marker. (>>) + $state = -1; + $e = Form::compose([[ "", $o, $k, "" ]]); + $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n"; + } + } + else { + # We saw a syntax error earlier, so we'll accumulate the + # contents of this form until the end. + $e .= "$line\n"; + } } + push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o); - foreach my $date (@limit_lastupdated) { - my ($start, $end) = ParseDateRange($date); - $Tickets->LimitLastUpdated( VALUE => $start, - OPERATOR => '>=' ) if ($start); - $Tickets->LimitLastUpdated ( VALUE => $end, - OPERATOR => '<=' ) if ($end); + foreach my $l (keys %$k) { + $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY'); } - foreach my $link (@limit_memberof) { - $Tickets->LimitMemberOf($link); - } + return \@forms; +} - foreach my $link (@limit_hasmember) { - $Tickets->LimitHasMember($link); - } +# Returns text representing a set of forms. +sub Form::compose { + my ($forms) = @_; + my @text; - foreach my $link (@limit_dependson) { - $Tickets->LimitDependsOn($link); - } + foreach my $form (@$forms) { + my ($c, $o, $k, $e) = @$form; + my $text = ""; - foreach my $link (@limit_dependedonby) { - $Tickets->LimitDependedOnBy($link); + if ($c) { + $c =~ s/\n*$/\n/; + $text = "$c\n"; + } + if ($e) { + $text .= $e; + } + elsif ($o) { + my @lines; + + foreach my $key (@$o) { + my ($line, $sp); + my $v = $k->{$key}; + my @values = ref $v eq 'ARRAY' ? @$v : $v; + + $sp = " "x(length("$key: ")); + $sp = " "x4 if length($sp) > 16; + + foreach $v (@values) { + if ($v =~ /\n/) { + $v =~ s/^/$sp/gm; + $v =~ s/^$sp//; + + if ($line) { + push @lines, "$line\n\n"; + $line = ""; + } + elsif (@lines && $lines[-1] !~ /\n\n$/) { + $lines[-1] .= "\n"; + } + push @lines, "$key: $v\n\n"; + } + elsif ($line && + length($line)+length($v)-rindex($line, "\n") >= 70) + { + $line .= ",\n$sp$v"; + } + else { + $line = $line ? "$line, $v" : "$key: $v"; + } + } + + $line = "$key:" unless @values; + if ($line) { + if ($line =~ /\n/) { + if (@lines && $lines[-1] !~ /\n\n$/) { + $lines[-1] .= "\n"; + } + $line .= "\n"; + } + push @lines, "$line\n"; + } + } + + $text .= join "", @lines; + } + else { + chomp $text; + } + push @text, $text; } - foreach my $link (@limit_refersto) { - $Tickets->LimitRefersTo($link); - } - - foreach my $link (@limit_referredtoby) { - $Tickets->LimitReferredToBy($link); - } - - if ($limit_first){ - } - if ($limit_rows){ - } + return join "\n--\n\n", @text; +} -# }}} - - # {{{ Iterate through all tickets we found +# Configuration. +# -------------- +# Returns configuration information from the environment. +sub config_from_env { + my %env; - my ($format, $titles, $code); - - #Set up the summary format if we need to - if (defined $summary) { - my $format_string = $summary || $ENV{'RT_SUMMARY_FORMAT'} || "%id4%status4%queue7%subject40%requestor16"; + foreach my $k ("DEBUG", "USER", "PASSWD", "SERVER") { + if (exists $ENV{"RT$k"}) { + $env{lc $k} = $ENV{"RT$k"}; + } + } - ($format, $titles, $code) = BuildListingFormat($format_string); - printf "$format\n", eval "$titles"; - } + return %env; +} - +# Finds a suitable configuration file and returns information from it. +sub config_from_file { + my ($rc) = @_; - while (my $Ticket = $Tickets->Next()) { - $RT::Logger->debug ("Now working on ticket ". $Ticket->id); - - #Run through all the ticket modifications we might want to do - #TODO: these are all insufficiently lazy and should be replaced with some - # nice foreaches. - - - # {{{ deal with watchers - - # add / delete requestors - foreach $value (@requestors) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - - $Ticket->AddRequestor(Email => $addr) if ($op eq '+'); - $Ticket->DeleteRequestor( $addr) if ($op eq '-'); - } - } - - # add / delete ccs - foreach $value (@cc) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - $Ticket->AddCc(Email => $addr) if ($op eq '+'); - $Ticket->DeleteCc($addr) if ($op eq '-'); - } - } - - # add / delete adminccs - $RT::Logger->debug("Looking at admin ccs"); - foreach $value (@admincc) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $addr = $2; - $Ticket->AddAdminCc(Email => $addr) if ($op eq '+'); - $Ticket->DeleteAdminCc($addr) if ($op eq '-'); - } - } - - # }}} - - # {{{ Deal with ticket keywords - - my $KeywordSelects = $Ticket->QueueObj->KeywordSelects(); - $RT::Logger->debug ("Looking at keywords"); - foreach $value (@keywords) { - $RT::Logger->debug("Looking at --keyword=$value"); - if ($value =~ /^(\W?)(.*?)\/(.*)$/) { - my $op = $1; - my $select = $2; - my $keyword = $3; - - $RT::Logger->debug("Going to $op Keyword $select / $keyword"); - while (my $ks = $KeywordSelects->Next) { - $RT::Logger->debug("$select is select ".$ks->Name." is found"); - next unless ($ks->Name =~ /$select/i); - $RT::Logger->debug ("Found a match for $select\n"); - my $kids = $ks->KeywordObj->Descendents; - - my ($kid); - foreach $kid (keys %{$kids}) { - $RT::Logger->debug("Now comparing $keyword with ".$kids->{$kid}. "\n"); - next unless ($kids->{$kid} =~ /^$keyword$/i); - $RT::Logger->debug("Going to $op $select / $keyword (".$kids->{$kid} .")"); - $Ticket->DeleteKeyword(KeywordSelect => $ks->id, - Keyword => $kid) if ($op eq '-'); - - $Ticket->AddKeyword(KeywordSelect => $ks->id, - Keyword => $kid) if ($op eq '+'); - } - - } - } - } - # }}} - - # {{{ deal with links - - # Deal with merging { - if ($mergeinto) { - my ($trans, $msg) =$Ticket->MergeInto($mergeinto); - print $msg."\n"; - } - # add /delete depends-ons - - foreach my $value (@dependson) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if (!$op or ($op eq '+')) { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'DependsOn', Target => $ticket); - print $msg."\n"; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'DependsOn', Target => $ticket); - print $msg."\n"; - } - - } - } - # add /delete member-of - foreach my $value (@memberof) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if ($op eq '+') { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'MemberOf', Target => $ticket); - print $msg; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'MemberOf', Target => $ticket); - print $msg; - } - - } - } - # add / delete refers-to - foreach my $value (@refersto) { - if ($value =~ /^(\W?)(.*)$/) { - my $op = $1; - my $ticket = $2; - if ($op eq '+') { - my ($trans, $msg) = - $Ticket->AddLink(Type => 'RefersTo', Target => $ticket); - print $msg; - } - elsif ($op eq '-') { - my ($trans, $msg) = - $Ticket->DeleteLink(Type => 'RefersTo', Target => $ticket); - print $msg; - } - - } - } - - # }}} - - # {{{ deal with dates - - #set due - if ($due) { - my $iso = ParseDateToISO($due); - if ($iso) { - $RT::Logger->debug("Setting due date to $iso ($due)"); - my ($trans, $msg) = - $Ticket->SetDue($iso); - print $msg; - } - else { - print "Due date '$due' could not be parsed"; - } - } - - #set starts - if ($starts) { - my $iso = ParseDateToISO($due); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetStarts($iso); - print $msg."\n"; - } - else { - print "Starts date '$starts' could not be parsed"; - } - } - #set started - if ($started) { - my $iso = ParseDateToISO($started); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetStarted($iso); - print $msg."\n"; - } - else { - print "Started date '$started' could not be parsed"; - } - } - #set contacted - if ($contacted) { - my $iso = ParseDateToISO($contacted); - if ($iso) { - my ($trans, $msg) = - $Ticket->SetContacted($iso); - print $msg."\n"; - } - else { - print "Contacted date '$contacted' could not be parsed"; - } - } - - # }}} - - # {{{ set other attributes - - #Set subject - if ($subject) { - my ($trans, $msg) = $Ticket->SetSubject($subject); - print $msg."\n"; - } - - #Set priority - if ($priority) { - my ($trans, $msg) = - $Ticket->SetPriority($priority); - print $msg."\n"; - } - - #Set final priority - if ($final_priority) { - my ($trans, $msg) = - $Ticket->SetFinalPriority($final_priority); - print $msg."\n"; - } - - #Set status - if ($status) { - my ($trans, $msg) = - $Ticket->SetStatus($status); - print $msg."\n"; - } - - #Set time left - if ($time_left) { - my ($trans, $msg) = - $Ticket->SetTimeLeft($time_left); - print $msg."\n"; - } - - #Set time_taken - if ($time_taken) { - my ($trans, $msg) = - $Ticket->SetTimeTaken($time_taken); - print $msg."\n"; - } - - #Set owner - if ($owner) { - my ($trans, $msg) = - $Ticket->SetOwner($owner); - print $msg."\n"; - } - - # Steal - if ($steal) { - my ($trans, $msg) = - $Ticket->Steal(); - print $msg . "\n"; + if ($rc =~ m#^/#) { + # We'll use an absolute path if we were given one. + return parse_config_file($rc); + } + else { + # Otherwise we'll use the first file we can find in the current + # directory, or in one of its (increasingly distant) ancestors. + + my @dirs = split /\//, cwd; + while (@dirs) { + my $file = join('/', @dirs, $rc); + if (-r $file) { + return parse_config_file($file); + } + + # Remove the last directory component each time. + pop @dirs; + } + + # Still nothing? We'll fall back to some likely defaults. + for ("$HOME/$rc", "/etc/rt.conf") { + return parse_config_file($_) if (-r $_); } - #Set queue - if ($queue) { - my ($trans, $msg) = - $Ticket->SetQueue($queue); - print $msg."\n"; - } - - # }}} - - - - # {{{ Perform ticket comments/replies - if ($reply) { - $RT::Logger->debug("Replying to ticket ".$Ticket->Id); - - my $linesref = GetMessageContent( Edit => $edit, Source => $source, - CurrentUser => $CurrentUser - ); - - #TODO build this entity - require MIME::Entity; - my $MIMEObj = MIME::Entity->build(Data => $linesref); - - $Ticket->Correspond( MIMEObj => $MIMEObj , - TimeTaken => $time_taken); - } - - elsif ($comment) { - $RT::Logger->debug("Commenting on ticket ".$Ticket->Id); - - my $linesref =GetMessageContent(Edit => $edit, Source => $source, - CurrentUser => $CurrentUser); - #TODO build this entity - require MIME::Entity; - my $MIMEObj = MIME::Entity->build(Data => $linesref); - - $Ticket->Comment( MIMEObj => $MIMEObj, - TimeTaken => $time_taken); - } - - # }}} - - # {{{ Display whatever we need to display - - # {{{ Display a full ticket listing and history - if ($history) { - #Display the history - $RT::Logger->debug("Show history for ".$Ticket->id); - - if ($Ticket->CurrentUserHasRight("ShowTicket")) { - &ShowSummary($Ticket); - print "\n"; - &ShowHistory($Ticket); - } - else { - print "You don't have permission to view that ticket.\n"; - } - } - - # }}} - - # {{{ Display a summary if we need to - if (defined $summary) { - $RT::Logger->debug ("Show ticket summary with format $format"); - - printf $format."\n", eval $code; - - } - # }}} - - # }}} - } - # }}} - + return (); } +# Makes a hash of the specified configuration file. +sub parse_config_file { + my %cfg; + my ($file) = @_; + + open(CFG, $file) && do { + while () { + chomp; + next if (/^#/ || /^\s*$/); + + if (/^(user|passwd|server)\s+([^ ]+)$/) { + $cfg{$1} = $2; + } + else { + die "rt: $file:$.: unknown configuration directive.\n"; + } + } + }; -$RT::Handle->Disconnect(); + return %cfg; +} +# Helper functions. +# ----------------- +sub whine { + my $sub = (caller(1))[3]; + $sub =~ s/^main:://; + warn "rt: $sub: @_\n"; + return; +} +sub read_passwd { + eval 'require Term::ReadKey'; + if ($@) { + die "No password specified (and Term::ReadKey not installed).\n"; + } + print "Password: "; + Term::ReadKey::ReadMode('noecho'); + chomp(my $passwd = Term::ReadKey::ReadLine(0)); + Term::ReadKey::ReadMode('restore'); + print "\n"; + return $passwd; +} +sub vi { + my ($text) = @_; + my $file = "/tmp/rt.form.$$"; + my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi"; -# {{{ sub ParseBooleanOp + local *F; + local $/ = undef; -=head2 ParseBooleanOp + open(F, ">$file") || die "$file: $!\n"; print F $text; close(F); + system($editor, $file) && die "Couldn't run $editor.\n"; + open(F, $file) || die "$file: $!\n"; $text = ; close(F); + unlink($file); - Takes an option modifier. returns the apropriate SQL operator. - If it's handed ! or -, returns !=. Otherwise returns =. + return $text; +} -=cut +# Add a value to a (possibly multi-valued) hash key. +sub vpush { + my ($hash, $key, $val) = @_; + my @val = ref $val eq 'ARRAY' ? @$val : $val; -sub ParseBooleanOp { - - my $op = shift; - - #so that !new limits to not new, etc - if ($op =~ /^(\!|-)/) { - $op = "!="; + if (exists $hash->{$key}) { + unless (ref $hash->{$key} eq 'ARRAY') { + my @v = $hash->{$key} ne '' ? $hash->{$key} : (); + $hash->{$key} = \@v; + } + push @{ $hash->{$key} }, @val; } else { - $op = "="; + $hash->{$key} = $val; } - - return($op); } -# }}} +# "Normalise" a hash key that's known to be multi-valued. +sub vsplit { + my ($val) = @_; + my ($word, @words); + my @values = ref $val eq 'ARRAY' ? @$val : $val; + + foreach my $line (map {split /\n/} @values) { + # XXX: This should become a real parser, à la Text::ParseWords. + $line =~ s/^\s+//; + $line =~ s/\s+$//; + push @words, split /\s*,\s*/, $line; + } + + return \@words; +} + +sub expand_list { + my ($list) = @_; + my ($elt, @elts, %elts); -# {{{ sub ParseLikeOp -=head2 ParseLikeOp + foreach $elt (split /,/, $list) { + if ($elt =~ /^(\d+)-(\d+)$/) { push @elts, ($1..$2) } + else { push @elts, $elt } + } - Takes an option modifier. returns the apropriate SQL operator. - If it's handed ! or -, returns NOT LIKE. Otherwise returns LIKE + @elts{@elts}=(); + return sort {$a<=>$b} keys %elts; +} -=cut +sub get_type_argument { + my $type; -sub ParseLikeOp { - - my $op = shift; - - #so that !new limits to not new, etc - if ($op =~ /^(\!|-)/) { - $op = "NOT LIKE"; + if (@ARGV) { + $type = shift @ARGV; + unless ($type =~ /^[A-Za-z0-9_.-]+$/) { + # We want whine to mention our caller, not us. + @_ = ("Invalid type '$type' specified."); + goto &whine; + } } else { - $op = "LIKE"; + @_ = ("No type argument specified with -t."); + goto &whine; } - - return($op); + + $type =~ s/s$//; # "Plural". Ugh. + return $type; } -# }}} -# {{{ sub ParseDateToISO +sub get_var_argument { + my ($data) = @_; -=head2 ParseDateToISO + if (@ARGV) { + my $kv = shift @ARGV; + if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) { + push @{ $data->{$k} }, $v; + } + else { + @_ = ("Invalid variable specification: '$kv'."); + goto &whine; + } + } + else { + @_ = ("No variable argument specified with -S."); + goto &whine; + } +} -Takes a date in an arbitrary format. -Returns an ISO date and time in GMT +sub is_object_spec { + my ($spec, $type) = @_; -=cut + $spec =~ s|^(?:$type/)?|$type/| if defined $type; + return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o); + return; +} -sub ParseDateToISO { - my $date = shift; +__DATA__ - my $date_obj = new RT::Date($CurrentUser); - $date_obj->Set( Format => 'unknown', - Value => $date - ); - return ($date_obj->ISO); -} +Title: intro +Title: introduction +Text: -# }}} + ** THIS IS AN UNSUPPORTED PREVIEW RELEASE ** + ** PLEASE REPORT BUGS TO rt-bugs@fsck.com ** -# {{{ sub ParseDateRange + This is a command-line interface to RT 3. -=head2 ParseDateRange [RANGE] + It allows you to interact with an RT server over HTTP, and offers an + interface to RT's functionality that is better-suited to automation + and integration with other tools. -Takes a range of dates of the form [][-][] and returns -starting and ending dates (as ISOs) If a date is specified as neither a starting nor ending -date, we parse it it as "midnight tonight to midnight tomorrow" + In general, each invocation of this program should specify an action + to perform on one or more objects, and any other arguments required + to complete the desired action. -=cut + For more information: -sub ParseDateRange { - my $in = shift; - my ($start, $end); - - - use RT::Date; - my $start_obj = new RT::Date($CurrentUser); - my $end_obj = new RT::Date($CurrentUser); - - if ($in =~ /^(.*?)-(.*?)$/) { - $start = $1; - $end = $2; - - if ($start) { - $start_obj->Set(Format => 'unknown', - Value => $start); - } - if ($end) { - $end_obj->Set(Format => 'unknown', - Value => $end); - } - } - else { - $start = $in; - $end = $in; - - $start_obj->Set(Format => 'unknown', - Value => $start); - - $end_obj->Set(Format => 'unknown', - Value => $end); - - $start_obj->SetToMidnight(); - $end_obj->SetToMidnight(); - $end_obj->AddDay(); - } - - if ($start) { - $start = $start_obj->ISO; - } - if ($end) { - $end = $end_obj->ISO; - } + - rt help actions (a list of possible actions) + - rt help objects (how to specify objects) + - rt help usage (syntax information) - return ($start, $end); -} + - rt help config (configuration details) + - rt help examples (a few useful examples) + - rt help topics (a list of help topics) -# }}} +-- -# {{{ ParseRange -=head2 ParseRange [RANGE] +Title: usage +Title: syntax +Text: -Takes a range of the form [][-][] and returns -a first and a last value. If the - is omitted, both $start and $end are the same. -=cut + Syntax: -sub ParseRange { - my $in = shift; - my ($start, $end); - - if ($in =~ /(.*?)-(.*?)/) { - $start = $1; - $end = $2; - } - else { - $start = $in; - $end = $in; - } - - return ($start, $end); - + rt [options] [arguments] - -} + Each invocation of this program must specify an action (e.g. "edit", + "create"), options to modify behaviour, and other arguments required + by the specified action. (For example, most actions expect a list of + numeric object IDs to act upon.) -# }}} - -# {{{ sub ShowSummary - -sub ShowSummary { - my $Ticket = shift; - - - print <Id]} Status:@{[$Ticket->Status]} Worked: @{[$Ticket->TimeWorked]} minutes Queue:@{[$Ticket->QueueObj->Name]} - Subject: @{[$Ticket->Subject]} - Requestors: @{[$Ticket->RequestorsAsString]} - Cc: @{[$Ticket->CcAsString]} - Admin Cc: @{[$Ticket->AdminCcAsString]} - Owner: @{[$Ticket->OwnerObj->Name]} - Priority: @{[$Ticket->Priority]} / @{[$Ticket->FinalPriority]} - Due: @{[$Ticket->DueAsString]} - Created: @{[$Ticket->CreatedAsString]} (@{[$Ticket->AgeAsString]}) - Last Contact: @{[$Ticket->ToldAsString]} (@{[$Ticket->LongSinceToldAsString]}) - Last Update: @{[$Ticket->LastUpdatedAsString]} by @{[$Ticket->LastUpdatedByObj->Name]} - -EOFORM - -my $selects = $Ticket->QueueObj->KeywordSelects(); - #get the keyword selects - print "Keywords:\n"; - while (my $select = $selects->Next) { - print "\t" .$select->Name .": "; - my $keys = $Ticket->KeywordsObj($select->id); - while (my $key = $keys->Next) { - print $key->KeywordObj->RelativePath($select->KeywordObj) . " "; - - } - print "\n"; - } + The details of the syntax and arguments for each action are given by + "rt help ". Some actions may be referred to by more than one + name ("create" is the same as "new", for example). + + Objects are identified by a type and an ID (which can be a name or a + number, depending on the type). For some actions, the object type is + implied (you can only comment on tickets); for others, the user must + specify it explicitly. See "rt help objects" for details. + + In syntax descriptions, mandatory arguments that must be replaced by + appropriate value are enclosed in <>, and optional arguments are + indicated by [] (for example, and [options] above). + + For more information: + + - rt help objects (how to specify objects) + - rt help actions (a list of actions) + - rt help types (a list of object types) + +-- + +Title: conf +Title: config +Title: configuration +Text: + + This program has two major sources of configuration information: its + configuration files, and the environment. + + The program looks for configuration directives in a file named .rtrc + (or $RTCONFIG; see below) in the current directory, and then in more + distant ancestors, until it reaches /. If no suitable configuration + files are found, it will also check for ~/.rtrc and /etc/rt.conf. + + Configuration directives: + + The following directives may occur, one per line: + + - server URL to RT server. + - user RT username. + - passwd RT user's password. + + Blank and #-commented lines are ignored. + + Environment variables: + + The following environment variables override any corresponding + values defined in configuration files: + + - RTUSER + - RTPASSWD + - RTSERVER + - RTDEBUG Numeric debug level. (Set to 3 for full logs.) + - RTCONFIG Specifies a name other than ".rtrc" for the + configuration file. + +-- + +Title: objects +Text: + + Syntax: + + /[/] + + Every object in RT has a type (e.g. "ticket", "queue") and a numeric + ID. Some types of objects can also be identified by name (like users + and queues). Furthermore, objects may have named attributes (such as + "ticket/1/history"). + + An object specification is like a path in a virtual filesystem, with + object types as top-level directories, object IDs as subdirectories, + and named attributes as further subdirectories. + + A comma-separated list of names, numeric IDs, or numeric ranges can + be used to specify more than one object of the same type. Note that + the list must be a single argument (i.e., no spaces). For example, + "user/root,1-3,5,7-10,ams" is a list of ten users; the same list + can also be written as "user/ams,root,1,2,3,5,7,8-20". -#iterate through the keyword selects. -#print the keyword select and all the related keywords + Examples: + ticket/1 + ticket/1/attachments + ticket/1/attachments/3 + ticket/1/attachments/3/content + ticket/1-3/links + ticket/1-3,5-7/history + user/ams + user/ams/rights + user/ams,rai,1/rights -#TODO: finish link descriptions -print "Dependencies: \n"; - while (my $l=$Ticket->DependedOnBy->Next) { - print $l->BaseObj->id," (",$l->BaseObj->Subject,") ",$l->Type," this ticket\n"; - } - while (my $l=$Ticket->DependsOn->Next) { - print "This ticket ",$l->Type," ",$l->TargetObj->Id," (",$l->TargetObj->Subject,")\n"; - } -} + For more information: -# }}} - -# {{{ sub ShowHistory -sub ShowHistory { - my $Ticket = shift; - my $Transaction; - my $Transactions = $Ticket->Transactions; - - while ($Transaction = $Transactions->Next) { - &ShowTransaction($Transaction); - } - } -# }}} - -# {{{ sub ShowTransaction -sub ShowTransaction { - my $transaction = shift; - -print <CreatedAsString]} (@{[$transaction->TimeTaken]} minutes) -@{[$transaction->Description]} -EOFORM - ; - my $attachments=$transaction->Attachments(); - while (my $message=$attachments->Next) { - print <Headers]} -EOFORM - - if ($message->ContentType =~ m{^(text/plain|message|text$)}) { - print $message->Content; - } else { - print $message->ContentType, " not shown"; - } - } - print "\n"; - return(); -} -# }}} - - -# {{{ sub BuildListingFormat - -sub BuildListingFormat { - my $format_string = shift; - - my ($id, @format, @code, @titles); - my ($field,$titles,$length, $format); - - my $code = ""; - - # {{{ attribs - my $attribs = { id => { chars => '4', - justify => 'r', - title => 'id', - value => '$Ticket->id', - }, - - queue => { chars => '8', - justify => 'l', - title => 'Queue', - value => '$Ticket->QueueObj->Name' - }, - subject => { chars => '30', - justify => 'l', - title => 'Subject', - value => '$Ticket->Subject', - }, - priority => { chars => '2', - justify => 'r', - title => 'Pri', - value => '$Ticket->Priority', - }, - final_priority => { chars => '2', - justify => 'r', - title => 'Fin', - value => '$Ticket->FinalPriority', - }, - time_worked => { chars => '6', - justify => 'r', - title => 'Worked', - value => '$Ticket->TimeWorked', - }, - time_left => { chars => '5', - justify => 'r', - title => 'Left', - value => '$Ticket->TimeLeft', - - }, - - status => { chars => '6', - justify => 'r', - title => 'Status', - value => '$Ticket->Status', - }, - owner => { chars => '10', - justify => 'r', - title => 'Owner', - value => '$Ticket->OwnerObj->Name' - }, - requestor => { chars => '10', - justify => 'r', - title => 'Requestor', - value => '$Ticket->RequestorsAsString' - }, - created => { chars => '12', - justify => 'r', - title => 'Created', - value => '$Ticket->CreatedAsString' - }, - updated => { chars => '12', - justify => 'r', - title => 'Updated', - value => '$Ticket->LastUpdatedAsString' - }, - due => { chars => '12', - justify => 'r', - title => 'Due', - value => '$Ticket->DueAsString' - }, - told => { chars => '12', - justify => 'r', - title => 'Told', - value => '$Ticket->ToldAsString' - }, - - - - }; - - # }}} + - rt help (action-specific details) + - rt help (type-specific details) + +-- + +Title: actions +Title: commands +Text: + + You can currently perform the following actions on all objects: + + - list (list objects matching some condition) + - show (display object details) + - edit (edit object details) + - create (create a new object) + + Each type may define actions specific to itself; these are listed in + the help item about that type. + + For more information: + + - rt help (action-specific details) + - rt help types (a list of possible types) + +-- + +Title: types +Text: + + You can currently operate on the following types of objects: + + - tickets + - users + - groups + - queues + + For more information: + + - rt help (type-specific details) + - rt help objects (how to specify objects) + - rt help actions (a list of possible actions) + +-- + +Title: ticket +Text: + + Tickets are identified by a numeric ID. + + The following generic operations may be performed upon tickets: + + - list + - show + - edit + - create + + In addition, the following ticket-specific actions exist: + + - link + - merge + - comment + - correspond + + Attributes: + + The following attributes can be used with "rt show" or "rt edit" + to retrieve or edit other information associated with tickets: + + links A ticket's relationships with others. + history All of a ticket's transactions. + history/type/ Only a particular type of transaction. + history/id/ Only the transaction of the specified id. + attachments A list of attachments. + attachments/ The metadata for an individual attachment. + attachments//content The content of an individual attachment. + +-- + +Title: user +Title: group +Text: + + Users and groups are identified by name or numeric ID. + + The following generic operations may be performed upon them: + + - list + - show + - edit + - create + + In addition, the following type-specific actions exist: + + - grant + - revoke + + Attributes: + + The following attributes can be used with "rt show" or "rt edit" + to retrieve or edit other information associated with users and + groups: + + rights Global rights granted to this user. + rights/ Queue rights for this user. + +-- + +Title: queue +Text: + + Queues are identified by name or numeric ID. + + Currently, they can be subjected to the following actions: + + - show + - edit + - create + +-- + +Title: logout +Text: + + Syntax: + + rt logout + + Terminates the currently established login session. You will need to + provide authentication credentials before you can continue using the + server. (See "rt help config" for details about authentication.) + +-- + +Title: ls +Title: list +Title: search +Text: + + Syntax: + + rt [options] "query string" + + Displays a list of objects matching the specified conditions. + ("ls", "list", and "search" are synonyms.) + + Conditions are expressed in the SQL-like syntax used internally by + RT3. (For more information, see "rt help query".) The query string + must be supplied as one argument. + + (Right now, the server doesn't support listing anything but tickets. + Other types will be supported in future; this client will be able to + take advantage of that support without any changes.) + + Options: + + The following options control how much information is displayed + about each matching object: + + -i Numeric IDs only. (Useful for |rt edit -; see examples.) + -s Short description. + -l Longer description. + + In addition, + + -o +/- Orders the returned list by the specified field. + -S var=val Submits the specified variable with the request. + -t type Specifies the type of object to look for. (The + default is "ticket".) + + Examples: + + rt ls "Priority > 5 and Status='new'" + rt ls -o +Subject "Priority > 5 and Status='new'" + rt ls -o -Created "Priority > 5 and Status='new'" + rt ls -i "Priority > 5"|rt edit - set status=resolved + rt ls -t ticket "Subject like '[PATCH]%'" + +-- + +Title: show +Text: + + Syntax: + + rt show [options] + + Displays details of the specified objects. + + For some types, object information is further classified into named + attributes (for example, "1-3/links" is a valid ticket specification + that refers to the links for tickets 1-3). Consult "rt help " + and "rt help objects" for further details. + + This command writes a set of forms representing the requested object + data to STDOUT. + + Options: + + - Read IDs from STDIN instead of the command-line. + -t type Specifies object type. + -f a,b,c Restrict the display to the specified fields. + -S var=val Submits the specified variable with the request. + + Examples: + + rt show -t ticket -f id,subject,status 1-3 + rt show ticket/3/attachments/29 + rt show ticket/3/attachments/29/content + rt show ticket/1-3/links + rt show -t user 2 + +-- + +Title: new +Title: edit +Title: create +Text: + + Syntax: + + rt edit [options] set field=value [field=value] ... + add field=value [field=value] ... + del field=value [field=value] ... + + Edits information corresponding to the specified objects. + + If, instead of "edit", an action of "new" or "create" is specified, + then a new object is created. In this case, no numeric object IDs + may be specified, but the syntax and behaviour remain otherwise + unchanged. + + This command typically starts an editor to allow you to edit object + data in a form for submission. If you specified enough information + on the command-line, however, it will make the submission directly. + + The command line may specify field-values in three different ways. + "set" sets the named field to the given value, "add" adds a value + to a multi-valued field, and "del" deletes the corresponding value. + Each "field=value" specification must be given as a single argument. + + For some types, object information is further classified into named + attributes (for example, "1-3/links" is a valid ticket specification + that refers to the links for tickets 1-3). These attributes may also + be edited. Consult "rt help " and "rt help object" for further + details. + + Options: + + - Read numeric IDs from STDIN instead of the command-line. + (Useful with rt ls ... | rt edit -; see examples below.) + -i Read a completed form from STDIN before submitting. + -o Dump the completed form to STDOUT instead of submitting. + -e Allows you to edit the form even if the command-line has + enough information to make a submission directly. + -S var=val + Submits the specified variable with the request. + -t type Specifies object type. + + Examples: + + # Interactive (starts $EDITOR with a form). + rt edit ticket/3 + rt create -t ticket + + # Non-interactive. + rt edit ticket/1-3 add cc=foo@example.com set priority=3 + rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved + rt edit ticket/4 set priority=3 owner=bar@example.com \ + add cc=foo@example.com bcc=quux@example.net + rt create -t ticket subject='new ticket' priority=10 \ + add cc=foo@example.com + +-- + +Title: comment +Title: correspond +Text: + + Syntax: + + rt [options] + + Adds a comment (or correspondence) to the specified ticket (the only + difference being that comments aren't sent to the requestors.) + + This command will typically start an editor and allow you to type a + comment into a form. If, however, you specified all the necessary + information on the command line, it submits the comment directly. + + (See "rt help forms" for more information about forms.) + + Options: + + -m Specify comment text. + -a Attach a file to the comment. (May be used more + than once to attach multiple files.) + -c A comma-separated list of Cc addresses. + -b A comma-separated list of Bcc addresses. + -w