[Bps-public-commit] rt-extension-repeatticket branch, master, created. 46ee4586b244bae8f06411736430ad08fb541eb2
Jim Brandt
jbrandt at bestpractical.com
Thu Mar 28 11:41:01 EDT 2013
The branch, master has been created
at 46ee4586b244bae8f06411736430ad08fb541eb2 (commit)
- Log -----------------------------------------------------------------
commit 60cf0606ff555c2c1f3892bf8075f010d11145a4
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jun 7 13:26:01 2012 +0800
initial version
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..44c9c19
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,12 @@
+blib*
+Makefile
+Makefile.old
+Build
+Build.bat
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+RT-Extension-RepeatTicket-*
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..fdcb9de
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for RT-Extension-RepeatTicket
+
+0.01 Date/time
+ First version, released on an unsuspecting world.
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..63986b2
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,29 @@
+bin/rt-repeat-ticket
+Changes
+html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
+html/Callbacks/RepeatTicket/Ticket/Create.html/AfterBasics
+html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
+html/Ticket/Elements/EditRecurrence
+html/Ticket/ModifyRecurrence.html
+inc/Module/AutoInstall.pm
+inc/Module/Install.pm
+inc/Module/Install/AutoInstall.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Include.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/RTx.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/RT/Extension/RepeatTicket.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README.pod
+RT-Extension-RepeatTicket-0.01/Changes
+RT-Extension-RepeatTicket-0.01/lib/RT/Extension/RepeatTicket.pm
+RT-Extension-RepeatTicket-0.01/Makefile.PL
+RT-Extension-RepeatTicket-0.01/MANIFEST
+RT-Extension-RepeatTicket-0.01/README.pod
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..ed352aa
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,23 @@
+---
+abstract: 'The great new RT::Extension::RepeatTicket!'
+author:
+ - 'sunnavy, <sunnavy at bestpractical.com>'
+build_requires:
+ ExtUtils::MakeMaker: 6.36
+configure_requires:
+ ExtUtils::MakeMaker: 6.36
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: gpl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: RT-Extension-RepeatTicket
+no_index:
+ directory:
+ - html
+ - inc
+resources:
+ license: http://opensource.org/licenses/gpl-license.php
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..bd15472
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,6 @@
+use inc::Module::Install;
+RTx('RT-Extension-RepeatTicket');
+all_from('lib/RT/Extension/RepeatTicket.pm');
+
+&auto_install();
+&WriteAll;
diff --git a/README.pod b/README.pod
new file mode 120000
index 0000000..f92d99b
--- /dev/null
+++ b/README.pod
@@ -0,0 +1 @@
+lib/RT/Extension/RepeatTicket.pm
\ No newline at end of file
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
new file mode 100644
index 0000000..e51471c
--- /dev/null
+++ b/bin/rt-repeat-ticket
@@ -0,0 +1,45 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use lib '/opt/rt4/lib';
+
+use Getopt::Long;
+my %opt;
+GetOptions( \%opt, 'help|h', );
+
+if ( $opt{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
+}
+
+require RT;
+RT::LoadConfig();
+RT::Init();
+
+use RT::Attributes;
+
+my $attrs = RT::Attributes->new( RT->SystemUser );
+$attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
+
+use RT::Extension::RepeatTicket;
+my $today = DateTime->today( time_zone => RT->Config->Get('Timezone') );
+while ( my $attr = $attrs->Next ) {
+ RT::Extension::RepeatTicket::RepeatTicket( $attr, $today );
+}
+
+__END__
+
+=head1 NAME
+
+rt-repeat-ticket - repeat ticket
+
+=head1 SYNOPSIS
+
+ rt-repeat-ticket
+
+=head1 DESCRIPTION
+
+This script will repeat ticket according to the recurrence rule.
diff --git a/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged b/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
new file mode 100644
index 0000000..fdbcaa2
--- /dev/null
+++ b/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
@@ -0,0 +1,28 @@
+<%init>
+my $request_path = $HTML::Mason::Commands::r->path_info;
+if ( $request_path =~ m{^/Ticket/} ) {
+ if ( ( $DECODED_ARGS->{'id'} || '' ) =~ /^(\d+)$/ ) {
+ my $id = $1;
+ my $obj = RT::Ticket->new( $session{'CurrentUser'} );
+ $obj->Load($id);
+
+ my $actions = PageMenu()->child( actions => title => loc('Actions'), sort_order => 95 );
+ my $tabs = PageMenu();
+
+ my %can = %{ $obj->CurrentUser->PrincipalObj->HasRights( Object => $obj ) };
+ $can{'_ModifyOwner'} = $can{'OwnTicket'} || $can{'TakeTicket'} || $can{'StealTicket'};
+ my $can = sub {
+ unless ($_[0] eq 'ExecuteCode') {
+ return $can{$_[0]} || $can{'SuperUser'};
+ } else {
+ return !RT->Config->Get('DisallowExecuteCode')
+ && ( $can{'ExecuteCode'} || $can{'SuperUser'} );
+ }
+ };
+
+ if ( $can->('ModifyTicket') ) {
+ $tabs->child( repeat => title => loc('Recurrence'), path => "/Ticket/ModifyRecurrence.html?id=" . $id );
+ }
+ }
+}
+</%init>
diff --git a/html/Callbacks/RepeatTicket/Ticket/Create.html/AfterBasics b/html/Callbacks/RepeatTicket/Ticket/Create.html/AfterBasics
new file mode 100644
index 0000000..3291226
--- /dev/null
+++ b/html/Callbacks/RepeatTicket/Ticket/Create.html/AfterBasics
@@ -0,0 +1,6 @@
+<&| /Widgets/TitleBox, title => loc("Recurrence"), class=>'ticket-info-repeat-recurrence' &>
+<& /Ticket/Elements/EditRecurrence, ARGSRef => $ARGSRef, Initial => 1 &>
+</&>
+<%args>
+$ARGSRef
+</%args>
diff --git a/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn b/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
new file mode 100644
index 0000000..42ecb73
--- /dev/null
+++ b/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
@@ -0,0 +1,7 @@
+<&| /Widgets/TitleBox, title => loc("Recurrence"), class=>'ticket-info-repeat-recurrence' &>
+<& /Ticket/Elements/EditRecurrence, Ticket => $Ticket, ReadOnly => 1 &>
+</&>
+
+<%args>
+$Ticket
+</%args>
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
new file mode 100644
index 0000000..669a2f5
--- /dev/null
+++ b/html/Ticket/Elements/EditRecurrence
@@ -0,0 +1,270 @@
+<script>
+jQuery( function () {
+ jQuery('div.repeat input[name=repeat-enabled]').change( function () {
+ var val = jQuery(this).val();
+ if ( jQuery(this).is(':checked') ) {
+ jQuery('div.repeat div.repeat-toggle').removeClass('hidden');
+ }
+ else {
+ jQuery('div.repeat div.repeat-toggle').addClass('hidden');
+ }
+ } );
+
+ jQuery('div.repeat input[name=repeat-type]').change( function () {
+ var val = jQuery(this).val();
+ jQuery('div.repeat td.repeat-details:not(.repeat-details-'+val+')').addClass('hidden');
+ jQuery('div.repeat td.repeat-details-' +val ).removeClass('hidden');
+ } );
+
+% if ( $ReadOnly ) {
+ jQuery('div.repeat input, div.repeat select').attr('disabled', true);
+% }
+} );
+</script>
+<div class="repeat">
+<input name="repeat-enabled" type="checkbox" value="1" <% $ARGSRef->{'repeat-enabled'} ? 'checked="checked"' : '' |n %>/> <&|/l&>Enable Recurrence?</&>
+
+<div class="repeat-toggle <% $ARGSRef->{'repeat-enabled'} ? '' : 'hidden' %> ">
+<fieldset>
+<legend><&|/l&>Recurrence pattern</&></legend>
+<table width="100%" border="0">
+<tr>
+<td width="100px">
+ <table border="0">
+ <tr>
+ <td width="100px">
+ <input name="repeat-type" type="radio" value="daily" <% ($ARGSRef->{'repeat-type'} || '') eq 'daily' ? 'checked="checked"' : '' |n %> /> <&|/l&>Daily</&>
+ </td>
+ <td width="1" rowspan="4" bgcolor="#aaa"><br></td>
+ </tr>
+ <tr>
+ <td width="100px">
+ <input name="repeat-type" type="radio" value="weekly" <% ($ARGSRef->{'repeat-type'} || '') eq 'weekly' ? 'checked="checked"' : '' |n %>/> <&|/l&>Weekly</&>
+ </td>
+ </tr>
+ <tr>
+ <td width="100px">
+ <input name="repeat-type" type="radio" value="monthly" <% ($ARGSRef->{'repeat-type'} || '') eq 'monthly' ? 'checked="checked"' : '' |n %>/> <&|/l&>Monthly</&>
+ </td>
+ </tr>
+ <tr>
+ <td width="100px">
+ <input name="repeat-type" type="radio" value="yearly" <% ($ARGSRef->{'repeat-type'} || '') eq 'yearly' ? 'checked="checked"' : '' |n %>/> <&|/l&>Yearly</&>
+ </td>
+ </tr>
+ </table>
+</td>
+<td class="repeat-details repeat-details-daily <% ($ARGSRef->{'repeat-type'} || '' ) eq 'daily' ? '' : 'hidden' %>">
+ <table border="0">
+ <tr>
+ <td>
+ <input name="repeat-details-daily" type="radio" value="day" <% ($ARGSRef->{'repeat-details-daily'} || '') eq 'day' ? 'checked="checked"' : '' |n %>/>
+ <&|/l&>Every</&><input name="repeat-details-daily-day" type="text"
+size="4" value="<% $ARGSRef->{'repeat-details-daily-day'} || 1 %>" /> <&|/l&>Day(s)</&>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-daily" type="radio" value="weekday" <% ($ARGSRef->{'repeat-details-daily'} || '') eq 'weekday' ? 'checked="checked"' : '' |n %>/>
+ <&|/l&>Every Weekday</&>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-daily" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-daily'} || '') eq 'complete' ? 'checked="checked"' : '' |n %>/>
+ <&|/l&>Regenate new task</&><input name="repeat-details-daily-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-daily-complete'} || 1 %>" /> <&|/l&>day(s) after each task is completed</&>
+ </td>
+ </tr>
+ </table>
+</td>
+
+<td class="repeat-details repeat-details-weekly <% ($ARGSRef->{'repeat-type'} || '' ) eq 'weekly' ? '' : 'hidden' %>">
+ <table border="0">
+ <tr>
+ <td colspan="5">
+ <input name="repeat-details-weekly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-weekly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> />
+ <&|/l&>Recur every</&><input name="repeat-details-weekly-week" type="text"
+size="4" value="<% $ARGSRef->{'repeat-details-weekly-week'} || 1 %>" /> <&|/l&>week(s) on</&>
+ </td>
+ </tr>
+ <tr>
+ <td width="10px" />
+% for my $number ( 0 .. 6 ) {
+ <td>
+ <input name="repeat-details-weekly-weeks" type="checkbox" value="<%
+$number %>"
+% if ( $ARGSRef->{'repeat-details-weekly-weeks'} &&
+% ( ref $ARGSRef->{'repeat-details-weekly-weeks'} && grep { $_ == $number }
+% @{$ARGSRef->{'repeat-details-weekly-weeks'}} ||
+% ( $ARGSRef->{'repeat-details-weekly-weeks'} == $number ) ) ) {
+ checked="checked"
+% }
+
+/><% loc($week_labels[$number]) %>
+ </td>
+% if ( $number == 3 ) {
+ </tr>
+ <tr>
+ <td width="10px" />
+% }
+% }
+ </tr>
+ <tr>
+ <td colspan="5">
+ <input name="repeat-details-weekly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-weekly'} || '') eq 'complete' ? 'checked="checked"' : '' |n%>/>
+ <&|/l&>Regenate new task</&><input name="repeat-details-weekly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-weekly-complete'} || 1 %>" /> <&|/l&>week(s) after each task is completed</&>
+ </td>
+ </tr>
+ </table>
+</td>
+
+<td class="repeat-details repeat-details-monthly <% ($ARGSRef->{'repeat-type'} || '' ) eq 'monthly' ? '' : 'hidden' %>">
+ <table border="0">
+ <tr>
+ <td>
+ <input name="repeat-details-monthly" type="radio" value="day" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'day' ? 'checked="checked"' : '' |n %> /><&|/l&>Day</&>
+ <input name="repeat-details-monthly-day-day" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day'} || 1 %>" /> <&|/l&>of every</&>
+ <input name="repeat-details-monthly-day-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-month'} || 1 %>" /> <&|/l&>month(s)</&>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-monthly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
+<select name="repeat-details-monthly-week-number">
+% for my $number ( 1 .. 4 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-monthly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
+% }
+</select>
+
+<select name="repeat-details-monthly-week-week">
+% for my $number ( 0 .. 6 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-monthly-week-week'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
+% }
+</select>
+<&|/l&>of every</&><input name="repeat-details-monthly-week-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-week-month'} || 1 %>" /> <&|/l&>month(s)</&>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-monthly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'complete' ? 'checked="checked"' : '' |n %> />
+ <&|/l&>Regenate new task</&><input
+name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-complete'} || 1 %>" /> <&|/l&>month(s) after each task is completed</&>
+ </td>
+ </tr>
+ </table>
+</td>
+
+<td class="repeat-details repeat-details-yearly <% ($ARGSRef->{'repeat-type'} || '' ) eq 'yearly' ? '' : 'hidden' %>">
+ <table border="0">
+ <tr>
+ <td>
+ <input name="repeat-details-yearly" type="radio" value="day" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'day' ? 'checked="checked"' : '' |n %> /><&|/l&>Every</&>
+<select name="repeat-details-yearly-day-month">
+% for my $number ( 1 .. 12 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-day-month'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($month_labels[$number-1]) %></option>
+% }
+</select>
+ <input name="repeat-details-yearly-day-day" type="text" size="4" value="<% $ARGSRef->{'repeat-details-yearly-day-day'} || 1 %>" />
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-yearly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
+<select name="repeat-details-yearly-week-number">
+% for my $number ( 1 .. 4 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
+% }
+</select>
+
+<select name="repeat-details-yearly-week-week">
+% for my $number ( 0 .. 6 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-week'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
+% }
+</select>
+<&|/l&>of</&>
+
+<select name="repeat-details-yearly-week-month">
+% for my $number ( 1 .. 12 ) {
+ <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-month'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($month_labels[$number-1]) %></option>
+% }
+</select>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <input name="repeat-details-yearly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'complete' ? 'checked="checked"' : '' |n %> />
+ <&|/l&>Regenate new task</&><input name="repeat-details-yearly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-yearly-complete'} || 1 %>" /> <&|/l&>year(s) after each task is completed</&>
+ </td>
+ </tr>
+ </table>
+</td>
+
+</tr>
+</table>
+</fieldset>
+
+
+<fieldset>
+<legend><&|/l&>Range of recurrence</&></legend>
+<table width="100%" border="0">
+<tr>
+ <td rowspan="3">
+ <&|/l&>Start</&>:
+ <& /Elements/SelectDate, Name => 'repeat-start-date', ShowTime => 0, Default => $ARGSRef->{'repeat-start-date'} || '' &>
+ </td>
+ <td>
+ <input type="radio" name="repeat-end" value="none" <% ($ARGSRef->{'repeat-end'} || '') eq 'none' ? 'checked="checked"' : '' |n %>> <&|/l&>No end date</&>
+ </td>
+</tr>
+<tr>
+ <td>
+ <input type="radio" name="repeat-end" value="number" <% ($ARGSRef->{'repeat-end'} || '') eq 'number' ? 'checked="checked"' : '' |n %>> <&|/l&>End after</&>:
+<input type="text" size="6" name="repeat-end-number" value="<% $ARGSRef->{'repeat-end-number'} || 10 %>"> <&|/l&>occurrence(s)</&>
+% if ( $Initial ) {
+ <input name="repeat-occurrences" type="hidden" value="1">
+% } else {
+ Current: <input size="6" type="text" name="repeat-occurrences" readonly="readonly" value="<% $ARGSRef->{'repeat-occurrences'} %>">
+% }
+ </td>
+</tr>
+<tr>
+ <td>
+ <input type="radio" name="repeat-end" value="date" <% ($ARGSRef->{'repeat-end'} || '') eq 'date' ? 'checked="checked"' : '' |n %>> <&|/l&>End by</&>:
+ <& /Elements/SelectDate, Name => 'repeat-end-date', ShowTime => 0, Default => $ARGSRef->{'repeat-end-date'} || '' &>
+ </td>
+</tr>
+</table>
+</fieldset>
+
+</div>
+
+</div>
+
+<%init>
+my @week_labels = qw/Sunday Monday Tuesday Wedsenday Thursday Friday Saturday/; # loc
+my @week_number_labels = qw/First Second Third Fourth/; # loc
+my @month_labels = qw/January February March April May June July August September October November December/; # loc
+
+if ( $Ticket ) {
+ my ($repeat) = $Ticket->Attributes->Named('RepeatTicketSettings');
+ if ( $repeat ) {
+ $ARGSRef = $repeat->Content if $repeat;
+ }
+ else {
+ $Initial = 1;
+ }
+}
+
+$ARGSRef->{'repeat-type'} ||= 'daily';
+$ARGSRef->{'repeat-details-daily'} ||= 'day';
+$ARGSRef->{'repeat-details-weekly'} ||= 'week';
+$ARGSRef->{'repeat-details-monthly'} ||= 'day';
+$ARGSRef->{'repeat-details-yearly'} ||= 'day';
+$ARGSRef->{'repeat-end'} ||= 'none';
+</%init>
+<%args>
+$ARGSRef => undef
+$Ticket => undef
+$ReadOnly => undef
+$Initial => undef
+</%args>
diff --git a/html/Ticket/ModifyRecurrence.html b/html/Ticket/ModifyRecurrence.html
new file mode 100644
index 0000000..9d09e24
--- /dev/null
+++ b/html/Ticket/ModifyRecurrence.html
@@ -0,0 +1,28 @@
+<& /Elements/Header, Title => loc('Modify recurrence for #[_1]', $TicketObj->Id) &>
+<& /Elements/Tabs &>
+
+<& /Elements/ListActions, actions => \@results &>
+
+<form method="post" action="ModifyRecurrence.html">
+<input type="hidden" class="hidden" name="id" value="<%$TicketObj->Id%>" />
+<&| /Widgets/TitleBox,title => loc('Modify recurrence for ticket # [_1]', $TicketObj->Id), class=> 'ticket-info-repeat' &>
+<& Elements/EditRecurrence, Ticket => $TicketObj &>
+</&>
+<& /Elements/Submit, Name => 'SubmitTicket', Label => loc('Save Changes') &>
+</form>
+
+
+<%INIT>
+
+my $TicketObj = LoadTicket($id);
+my @results;
+if ( $ARGS{SubmitTicket} ) {
+ my ( $ret, $message ) = RT::Extension::RepeatTicket::SetRepeatAttribute( $TicketObj, %ARGS );
+ push @results, $message;
+}
+
+</%INIT>
+
+<%ARGS>
+$id => undef
+</%ARGS>
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
new file mode 100644
index 0000000..aa7aa92
--- /dev/null
+++ b/inc/Module/AutoInstall.pm
@@ -0,0 +1,930 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use File::Spec ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.06';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
+ $UpgradeDeps
+);
+my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
+ $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
+ $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub _installdeps_target {
+ $InstallDepsTarget = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
+ $UpgradeDeps = 1;
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _version_of($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or $InstallDepsTarget
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
+ require Config;
+ my $make = $Config::Config{make};
+ if ($InstallDepsTarget) {
+ print
+"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
+ }
+ else {
+ print
+"*** Dependencies will be installed the next time you type '$make'.\n";
+ }
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ if ($ENV{PERL5_CPANM_IS_RUNNING}) {
+ return _running_under('cpanminus');
+ }
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed );
+ while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+ # grep out those already installed
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ if ($UpgradeDeps) {
+ push @modules, @installed;
+ @installed = ();
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ push @config, 'prereqs', $value;
+ } elsif ( $key eq 'force' ) {
+ push @config, $key, $value;
+ } elsif ( $key eq 'notest' ) {
+ push @config, 'skiptest', $value;
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^(?:force|notest)$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ if ($args{notest} && (not CPAN::Shell->can('notest'))) {
+ die "Your version of CPAN is too old to support the 'notest' pragma";
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = do {
+ if ($args{force}) {
+ CPAN::Shell->force( install => $pkg )
+ } elsif ($args{notest}) {
+ CPAN::Shell->notest( install => $pkg )
+ } else {
+ CPAN::Shell->install($pkg)
+ }
+ };
+
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# report version without loading a module
+sub _version_of {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ foreach my $dir ( @INC ) {
+ next if ref $dir;
+ my $path = File::Spec->catfile($dir, $file);
+ next unless -e $path;
+ require ExtUtils::MM_Unix;
+ return ExtUtils::MM_Unix->parse_version($path);
+ }
+ return undef;
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+
+ # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+ # CPAN::HandleConfig->load. CPAN reports that the redirection
+ # is deprecated in a warning printed at the user.
+
+ # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+ # $CPAN::HandleConfig::VERSION but cannot handle
+ # CPAN::Config->load
+
+ # Which "versions expect CPAN::Config->load?
+
+ if ( $CPAN::HandleConfig::VERSION
+ || CPAN::HandleConfig->can('load')
+ ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ my $deps_list = join( ',', @Missing, @Existing );
+
+ $PostambleActionsUpgradeDeps =
+ "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
+
+ my $config_notest =
+ join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
+ 'notest', 1 )
+ if $Config;
+
+ $PostambleActionsNoTest = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ $PostambleActionsUpgradeDepsNoTest =
+ "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
+
+ $PostambleActionsListDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
+
+ my @all = (@Missing, @Existing);
+
+ $PostambleActionsListAllDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+ my $fragment;
+
+ $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+AUTO_INSTALL
+
+ $fragment .= <<"END_MAKE";
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+installdeps_notest ::
+\t$PostambleActionsNoTest
+
+upgradedeps ::
+\t$PostambleActionsUpgradeDeps
+
+upgradedeps_notest ::
+\t$PostambleActionsUpgradeDepsNoTest
+
+listdeps ::
+\t$PostambleActionsListDeps
+
+listalldeps ::
+\t$PostambleActionsListAllDeps
+
+END_MAKE
+
+ return $fragment;
+}
+
+1;
+
+__END__
+
+#line 1193
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..4ecf46b
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,470 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.005;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '1.06';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
+
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+ }
+
+
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+ #-------------------------------------------------------------
+
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+
+ #-------------------------------------------------------------
+
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
+
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ $should_reload = 1;
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+ local *FH;
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[1]) <=> _version($_[2]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
new file mode 100644
index 0000000..6efe4fe
--- /dev/null
+++ b/inc/Module/Install/AutoInstall.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ my @features_require = Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ my %seen;
+ my @requires = map @$_, map @$_, grep ref, $self->requires;
+ while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+ while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+ while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+
+ my @deduped;
+ while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+ push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+ }
+
+ $self->requires(@deduped);
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub installdeps_target {
+ my ($self, @args) = @_;
+
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall::_installdeps_target(1);
+
+ $self->auto_install(@args);
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..802844a
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.06';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..22167b8
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,154 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# Check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..bee0c4f
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
new file mode 100644
index 0000000..8310e4c
--- /dev/null
+++ b/inc/Module/Install/Include.pm
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..7052f36
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,418 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
+sub makemaker_args {
+ my ($self, %new_args) = @_;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
+ return $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = shift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub _wanted_t {
+}
+
+sub tests_recursive {
+ my $self = shift;
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
+ require File::Find;
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ if ( $self->tests ) {
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
+ }
+ if ( $] >= 5.005 ) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
+ }
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ if ( $self->makemaker(6.17) and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
+
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
+ if ($self->bundles) {
+ my %processed;
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
+ }
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
+ }
+
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
+
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if ( my $preop = $self->admin->preop($user_preop) ) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
+ my $makefile = do { local $/; <MAKEFILE> };
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..58430f3
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,722 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
+ }
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
+ return 1;
+}
+
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the really old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ $self->{values}{all_from} = $file;
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless @{$self->author || []};
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
+}
+
+sub abstract_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub _extract_perl_version {
+ if (
+ $_[0] =~ m/
+ ^\s*
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
+ }
+ }
+ return '';
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
+}
+
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than one bugtracker link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..73b9cda
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,231 @@
+#line 1
+package Module::Install::RTx;
+
+use 5.008;
+use strict;
+use warnings;
+no warnings 'once';
+
+use Module::Install::Base;
+use base 'Module::Install::Base';
+our $VERSION = '0.29';
+
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+my @DIRS = qw(etc lib html bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
+sub RTx {
+ my ( $self, $name ) = @_;
+
+ my $original_name = $name;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ unless $self->version;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ } else {
+ local @INC = (
+ $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ @INC,
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+ } grep $_, @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $_ =~ s/\/RT\.pm$//;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ my $local_lib_path = "$RT::LocalPath/lib";
+ print "Using RT configuration from $INC{'RT.pm'}:\n";
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+ unshift @INC, $lib_path;
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
+ }
+
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ }
+
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
+
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
+ File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
+
+ # got schema, load factory module
+ $has_etc{schema}++;
+ $self->load('RTxFactory');
+ $self->postamble(<< ".");
+factory ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
+
+dropdb ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
+
+.
+ }
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
+ $has_etc{acl}++;
+ }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+
+ $self->postamble("$postamble\n");
+ unless ( $subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+ }
+
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ }
+}
+
+sub RTxInit {
+ unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
+ require RT;
+ RT::LoadConfig();
+ RT::ConnectToDatabase();
+
+ die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+}
+
+# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
+{ my %word = (
+ a => -4,
+ alpha => -4,
+ b => -3,
+ beta => -3,
+ pre => -2,
+ rc => -1,
+ head => 9999,
+);
+sub cmp_version($$) {
+ my ($a, $b) = (@_);
+ my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $a;
+ my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $b;
+ @a > @b
+ ? push @b, (0) x (@a- at b)
+ : push @a, (0) x (@b- at a);
+ for ( my $i = 0; $i < @a; $i++ ) {
+ return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
+ }
+ return 0;
+}}
+sub requires_rt {
+ my ($self,$version) = @_;
+
+ # if we're exactly the same version as what we want, silently return
+ return if ($version eq $RT::VERSION);
+
+ my @sorted = sort cmp_version $version,$RT::VERSION;
+
+ if ($sorted[-1] eq $version) {
+ # should we die?
+ warn "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ }
+}
+
+1;
+
+__END__
+
+#line 348
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..eeaa3fe
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..85d8018
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,63 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
+ }
+
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
+}
+
+1;
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
new file mode 100644
index 0000000..3934ea8
--- /dev/null
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -0,0 +1,414 @@
+use warnings;
+use strict;
+
+package RT::Extension::RepeatTicket;
+
+our $VERSION = "0.01";
+
+use RT::Interface::Web;
+use DateTime;
+use RT::Date;
+
+my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
+{
+ no warnings 'redefine';
+
+ *HTML::Mason::Commands::CreateTicket = sub {
+ my %args = @_;
+ my ( $ticket, @actions ) = $old_create_ticket->(@_);
+ SetRepeatAttribute( $ticket, %args ) if $ticket && $args{'repeat-enabled'};
+ return ( $ticket, @actions );
+ };
+}
+
+sub SetRepeatAttribute {
+ my $ticket = shift;
+ return 0 unless $ticket;
+ my %args = @_;
+ my %repeat_args = map { $_ => $args{$_} } grep { /^repeat/ } keys %args;
+
+ my ( $old_attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
+ my %old;
+ %old = %{$old_attr->Content} if $old_attr;
+
+ my $content = { %old, %repeat_args };
+ $ticket->SetAttribute(
+ Name => 'RepeatTicketSettings',
+ Content => $content,
+ );
+
+ return ( 1, $ticket->loc('Recurrence updated') ); # loc
+}
+
+use RT::Ticket;
+sub RepeatTicket {
+ my $attr = shift;
+ my $checkday = shift;
+
+ my $content = $attr->Content;
+ return unless $content->{'repeat-enabled'};
+
+ my $repeat_ticket = $attr->Object;
+
+ if ( $content->{'repeat-start-date'} ) {
+ my $date = RT::Date->new( RT->SystemUser );
+ $date->Set(
+ Format => 'unknown',
+ Value => $content->{'repeat-start-date'},
+ );
+ return unless $checkday->ymd ge $date->Date;
+ }
+
+ if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'number' ) {
+ return
+ unless $content->{'repeat-end-number'} >
+ $content->{'repeat-occurrences'};
+ }
+
+ if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'date' ) {
+ my $date = RT::Date->new( RT->SystemUser );
+ $date->Set(
+ Format => 'unknown',
+ Value => $content->{'repeat-end-date'},
+ );
+ return unless $checkday->ymd lt $date->Date;
+ }
+
+ my $last_ticket;
+ if ( $content->{'last-ticket'} ) {
+ $last_ticket = RT::Ticket->new( RT->SystemUser );
+ $last_ticket->Load( $content->{'last-ticket'} );
+ }
+
+ $last_ticket ||= $repeat_ticket;
+
+ my $due_date = $checkday->clone;
+
+ if ( $content->{'repeat-type'} eq 'daily' ) {
+ if ( $content->{'repeat-details-daily'} eq 'day' ) {
+ my $span = $content->{'repeat-details-daily-day'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( days => $span );
+ return unless CheckLastTicket( $date, $last_ticket );
+
+ $due_date->add( days => $span );
+ }
+ elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
+ return
+ unless $checkday->day_of_week >= 1 && $checkday->day_of_week <= 5;
+ if ( $checkday->day_of_week == 5 ) {
+ $due_date->add( days => 3 );
+ }
+ else {
+ $due_date->add( days => 1 );
+ }
+ }
+ elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract( days => $content->{'repeat-details-daily-complete'}
+ || 1 );
+ return if $resolved->Date gt $date->ymd;
+ }
+
+ }
+ elsif ( $content->{'repeat-type'} eq 'weekly' ) {
+ if ( $content->{'repeat-details-weekly'} eq 'week' ) {
+ my $span = $content->{'repeat-details-weekly-week'} || 1;
+ my $date = $checkday->clone;
+
+ # go to the end of the week
+ $date->subtract(
+ weeks => $span - 1,
+ days => $checkday->day_of_week
+ );
+ return unless CheckLastTicket( $date, $last_ticket );
+
+ my $weeks = $content->{'repeat-details-weekly-weeks'};
+ return unless $weeks;
+
+ $weeks = [$weeks] unless ref $weeks;
+ return unless grep { $_ == $checkday->day_of_week } @$weeks;
+
+ $due_date->add( weeks => $span );
+ $due_date->subtract( days => $due_date->day_of_week );
+ my ($first) = sort @$weeks;
+ $due_date->add( days => $first ) if $first;
+ }
+ elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ weeks => $content->{'repeat-details-weekly-complete'} || 1 );
+ return if $resolved->Date gt $date->ymd;
+ }
+ }
+ elsif ( $content->{'repeat-type'} eq 'monthly' ) {
+ if ( $content->{'repeat-details-monthly'} eq 'day' ) {
+ my $day = $content->{'repeat-details-monthly-day-day'} || 1;
+ return unless $day == $checkday->day_of_month;
+
+ my $span = $content->{'repeat-details-monthly-day-month'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( months => $span );
+ return unless CheckLastTicket( $date, $last_ticket );
+
+ $due_date->add( months => $span );
+ }
+ elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
+ my $day = $content->{'repeat-details-monthly-week-week'} || 0;
+ return unless $day == $checkday->day_of_week;
+
+ my $number = $content->{'repeat-details-monthly-week-number'} || 1;
+ return
+ unless $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+
+ my $span = $content->{'repeat-details-monthly-week-month'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( months => $span );
+ return unless CheckLastTicket( $date, $last_ticket );
+
+ $due_date->add( months => $span );
+ $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->add( weeks => $number - 1 );
+ if ( $day > $due_date->day_of_week ) {
+ $due_date->add( days => $day - $due_date->day_of_week );
+ }
+ elsif ( $day < $due_date->day_of_week ) {
+ $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ }
+ }
+ elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ months => $content->{'repeat-details-monthly-complete'} || 1 );
+ return if $resolved->Date gt $date->ymd;
+ }
+ }
+ elsif ( $content->{'repeat-type'} eq 'yearly' ) {
+ if ( $content->{'repeat-details-yearly'} eq 'day' ) {
+ my $day = $content->{'repeat-details-yearly-day-day'} || 1;
+ return unless $day == $checkday->day_of_month;
+
+ my $month = $content->{'repeat-details-yearly-day-month'} || 1;
+ return unless $month == $checkday->month;
+ $due_date->add( years => 1 );
+ }
+ elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
+ my $day = $content->{'repeat-details-yearly-week-week'} || 0;
+ return unless $day == $checkday->day_of_week;
+
+ my $month = $content->{'repeat-details-yearly-week-month'} || 1;
+ return unless $month == $checkday->month;
+
+ my $number = $content->{'repeat-details-yearly-week-number'} || 1;
+ return
+ unless $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+
+ $due_date->add( year => 1 );
+ $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->add( weeks => $number - 1 );
+ if ( $day > $due_date->day_of_week ) {
+ $due_date->add( days => $day - $due_date->day_of_week );
+ }
+ elsif ( $day < $due_date->day_of_week ) {
+ $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ }
+ }
+ elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ years => $content->{'repeat-details-yearly-complete'} || 1 );
+ return
+ if $resolved->Date gt $date->ymd;
+ }
+ }
+
+ # use RT::Date to work around the timezone issue
+ my $starts = RT::Date->new( RT->SystemUser );
+ $starts->Set( Format => 'unknown', Value => $checkday->ymd );
+
+ my $due = RT::Date->new( RT->SystemUser );
+ $due->Set( Format => 'unknown', Value => $due_date->ymd );
+
+ my ( $id, $txn, $msg ) = _RepeatTicket(
+ $repeat_ticket,
+ Starts => $starts->ISO,
+ $due_date eq $checkday
+ ? ()
+ : ( Due => $due->ISO ),
+ );
+
+ if ($id) {
+ $RT::Logger->info( "Repeated Ticket $id for " . $repeat_ticket->id );
+ $content->{'repeat-occurrences'}++;
+ $content->{'last-ticket'} = $id;
+ $attr->SetContent($content);
+ return ( $id, $txn, $msg );
+ }
+ else {
+ $RT::Logger->error(
+ "Failed to repeat ticket for " . $repeat_ticket->id . ": $msg" );
+ return;
+ }
+}
+
+sub _RepeatTicket {
+ my $repeat_ticket = shift;
+ return unless $repeat_ticket;
+
+ my %args = @_;
+ my $repeat = {
+ Queue => $repeat_ticket->Queue,
+ Requestor => join( ',', $repeat_ticket->RequestorAddresses ),
+ Cc => join( ',', $repeat_ticket->CcAddresses ),
+ AdminCc => join( ',', $repeat_ticket->AdminCcAddresses ),
+ InitialPriority => $repeat_ticket->Priority,
+ };
+
+ $repeat->{$_} = $repeat_ticket->$_()
+ for qw/Owner Subject FinalPriority TimeEstimated/;
+
+ my $members = $repeat_ticket->Members;
+ my ( @members, @members_of, @refers, @refers_by, @depends, @depends_by );
+ my $refers = $repeat_ticket->RefersTo;
+ my $get_link_value = sub {
+ my ( $link, $type ) = @_;
+ my $uri_method = $type . 'URI';
+ my $local_method = 'Local' . $type;
+ my $uri = $link->$uri_method;
+ return
+ if $uri->IsLocal
+ and $uri->Object
+ and $uri->Object->isa('RT::Ticket')
+ and $uri->Object->Type eq 'reminder';
+
+ return $link->$local_method || $uri->URI;
+ };
+ while ( my $refer = $refers->Next ) {
+ my $refer_value = $get_link_value->( $refer, 'Target' );
+ push @refers, $refer_value if defined $refer_value;
+ }
+ $repeat->{'new-RefersTo'} = join ' ', @refers;
+
+ my $refers_by = $repeat_ticket->ReferredToBy;
+ while ( my $refer_by = $refers_by->Next ) {
+ my $refer_by_value = $get_link_value->( $refer_by, 'Base' );
+ push @refers_by, $refer_by_value if defined $refer_by_value;
+ }
+ $repeat->{'RefersTo-new'} = join ' ', @refers_by;
+
+ my $cfs = $repeat_ticket->QueueObj->TicketCustomFields();
+ while ( my $cf = $cfs->Next ) {
+ my $cf_id = $cf->id;
+ my $cf_values = $repeat_ticket->CustomFieldValues( $cf->id );
+ my @cf_values;
+ while ( my $cf_value = $cf_values->Next ) {
+ push @cf_values, $cf_value->Content;
+ }
+ $repeat->{"Object-RT::Ticket--CustomField-$cf_id-Value"} = join "\n",
+ @cf_values;
+ }
+
+ $repeat->{Status} = 'new';
+
+ for ( keys %$repeat ) {
+ $args{$_} = $repeat->{$_} if not defined $args{$_};
+ }
+
+ my $txns = $repeat_ticket->Transactions;
+ $txns->Limit( FIELD => 'Type', VALUE => 'Create' );
+ $txns->OrderBy( FIELD => 'id', ORDER => 'ASC' );
+ $txns->RowsPerPage(1);
+ my $txn = $txns->First;
+
+ my $atts = RT::Attachments->new($RT::SystemUser);
+ $atts->OrderBy( FIELD => 'id', ORDER => 'ASC' );
+ $atts->Limit( FIELD => 'TransactionId', VALUE => $txn->id );
+ $atts->Limit( FIELD => 'Parent', VALUE => 0 );
+ $atts->RowsPerPage(1);
+
+ my $top = $atts->First;
+ if ($top) {
+ $args{MIMEObj} = $top->ContentAsMIME( Children => 1 );
+ }
+
+ my $ticket = RT::Ticket->new( RT->SystemUser );
+ return $ticket->Create(%args);
+}
+
+sub CheckLastTicket {
+ my $date = shift;
+ my $last_ticket = shift;
+ if ( $last_ticket->DueObj->Unix ) {
+ my $due = $last_ticket->DueObj;
+ $due->AddDays(-1);
+ if ( $date->ymd ge $due->Date( Timezone => 'user' ) ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+ }
+
+ if ( $date->ymd ge $last_ticket->CreatedObj->Date( Timezone => 'user' ) ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+RT::Extension::RepeatTicket - The great new RT::Extension::RepeatTicket!
+
+=head1 VERSION
+
+Version 0.01
+
+=head1 INSTALLATION
+
+To install this module, run the following commands:
+
+ perl Makefile.PL
+ make
+ make install
+
+add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
+
+ Set( @Plugins, qw(... RT::Extension::RepeatTicket) );
+
+=head1 AUTHOR
+
+sunnavy, <sunnavy at bestpractical.com>
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2012 sunnavy.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See http://dev.perl.org/licenses/ for more information.
+
+
commit d7d37829268a0f2519e631a2ff31244634642f00
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jun 7 13:35:10 2012 +0800
+x for rt-repeat-ticket
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
old mode 100644
new mode 100755
commit 66ce45ee1e227e57daf1851ed2246af7ef1c0c31
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jun 7 15:45:06 2012 +0800
cleanup
diff --git a/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged b/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
index fdbcaa2..3a72672 100644
--- a/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
+++ b/html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
@@ -6,7 +6,6 @@ if ( $request_path =~ m{^/Ticket/} ) {
my $obj = RT::Ticket->new( $session{'CurrentUser'} );
$obj->Load($id);
- my $actions = PageMenu()->child( actions => title => loc('Actions'), sort_order => 95 );
my $tabs = PageMenu();
my %can = %{ $obj->CurrentUser->PrincipalObj->HasRights( Object => $obj ) };
commit 1574bcfc417f79fbe0cf3967b76f2f3b4a064028
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jun 7 16:02:16 2012 +0800
copyright update
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 3934ea8..cbbb14d 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -403,7 +403,7 @@ sunnavy, <sunnavy at bestpractical.com>
=head1 LICENSE AND COPYRIGHT
-Copyright 2012 sunnavy.
+Copyright 2012 Best Practical Solutions, LLC.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
commit a927a0c04a696f51d444bf3ebde799f6d1c4fbab
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 04:00:58 2012 +0800
coexist repeated tickets support
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
index e51471c..0cf4efa 100755
--- a/bin/rt-repeat-ticket
+++ b/bin/rt-repeat-ticket
@@ -27,7 +27,7 @@ $attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
use RT::Extension::RepeatTicket;
my $today = DateTime->today( time_zone => RT->Config->Get('Timezone') );
while ( my $attr = $attrs->Next ) {
- RT::Extension::RepeatTicket::RepeatTicket( $attr, $today );
+ RT::Extension::RepeatTicket::Run( $attr, $today );
}
__END__
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index cbbb14d..7070789 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -16,7 +16,10 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
*HTML::Mason::Commands::CreateTicket = sub {
my %args = @_;
my ( $ticket, @actions ) = $old_create_ticket->(@_);
- SetRepeatAttribute( $ticket, %args ) if $ticket && $args{'repeat-enabled'};
+ if ( $ticket && $args{'repeat-enabled'} ) {
+ my ( $attr ) = SetRepeatAttribute( $ticket, %args );
+ MaybeRepeatMore( $attr );
+ }
return ( $ticket, @actions );
};
}
@@ -31,240 +34,271 @@ sub SetRepeatAttribute {
my %old;
%old = %{$old_attr->Content} if $old_attr;
- my $content = { %old, %repeat_args };
+ my $content = { %old, %repeat_args, tickets => [ $ticket->id ] };
+
$ticket->SetAttribute(
Name => 'RepeatTicketSettings',
Content => $content,
);
- return ( 1, $ticket->loc('Recurrence updated') ); # loc
+ my ( $attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
+
+ return ( $attr, $ticket->loc('Recurrence updated') ); # loc
}
use RT::Ticket;
-sub RepeatTicket {
- my $attr = shift;
- my $checkday = shift;
+sub Run {
+ my $attr = shift;
my $content = $attr->Content;
return unless $content->{'repeat-enabled'};
- my $repeat_ticket = $attr->Object;
-
- if ( $content->{'repeat-start-date'} ) {
- my $date = RT::Date->new( RT->SystemUser );
- $date->Set(
- Format => 'unknown',
- Value => $content->{'repeat-start-date'},
- );
- return unless $checkday->ymd ge $date->Date;
- }
-
- if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'number' ) {
- return
- unless $content->{'repeat-end-number'} >
- $content->{'repeat-occurrences'};
- }
-
- if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'date' ) {
- my $date = RT::Date->new( RT->SystemUser );
- $date->Set(
- Format => 'unknown',
- Value => $content->{'repeat-end-date'},
- );
- return unless $checkday->ymd lt $date->Date;
- }
-
- my $last_ticket;
- if ( $content->{'last-ticket'} ) {
- $last_ticket = RT::Ticket->new( RT->SystemUser );
- $last_ticket->Load( $content->{'last-ticket'} );
- }
+ my $checkday = shift
+ || DateTime->today( time_zone => RT->Config->Get('Timezone') );
+ RepeatTicket( $attr, $checkday );
+ MaybeRepeatMore( $attr ); # create more to meet the coexistent number
+}
- $last_ticket ||= $repeat_ticket;
+sub RepeatTicket {
+ my $attr = shift;
+ my @checkdays = @_;
+ my @ids;
- my $due_date = $checkday->clone;
+ my $content = $attr->Content;
+ return unless $content->{'repeat-enabled'};
- if ( $content->{'repeat-type'} eq 'daily' ) {
- if ( $content->{'repeat-details-daily'} eq 'day' ) {
- my $span = $content->{'repeat-details-daily-day'} || 1;
- my $date = $checkday->clone;
- $date->subtract( days => $span );
- return unless CheckLastTicket( $date, $last_ticket );
+ for my $checkday (@checkdays) {
+ my $repeat_ticket = $attr->Object;
- $due_date->add( days => $span );
- }
- elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
- return
- unless $checkday->day_of_week >= 1 && $checkday->day_of_week <= 5;
- if ( $checkday->day_of_week == 5 ) {
- $due_date->add( days => 3 );
- }
- else {
- $due_date->add( days => 1 );
- }
+ if ( $content->{'repeat-start-date'} ) {
+ my $date = RT::Date->new( RT->SystemUser );
+ $date->Set(
+ Format => 'unknown',
+ Value => $content->{'repeat-start-date'},
+ );
+ next unless $checkday->ymd ge $date->Date;
}
- elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
+
+ if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'number' )
+ {
return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract( days => $content->{'repeat-details-daily-complete'}
- || 1 );
- return if $resolved->Date gt $date->ymd;
+ unless $content->{'repeat-end-number'} >
+ $content->{'repeat-occurrences'};
}
- }
- elsif ( $content->{'repeat-type'} eq 'weekly' ) {
- if ( $content->{'repeat-details-weekly'} eq 'week' ) {
- my $span = $content->{'repeat-details-weekly-week'} || 1;
- my $date = $checkday->clone;
-
- # go to the end of the week
- $date->subtract(
- weeks => $span - 1,
- days => $checkday->day_of_week
+ if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'date' ) {
+ my $date = RT::Date->new( RT->SystemUser );
+ $date->Set(
+ Format => 'unknown',
+ Value => $content->{'repeat-end-date'},
);
- return unless CheckLastTicket( $date, $last_ticket );
-
- my $weeks = $content->{'repeat-details-weekly-weeks'};
- return unless $weeks;
-
- $weeks = [$weeks] unless ref $weeks;
- return unless grep { $_ == $checkday->day_of_week } @$weeks;
-
- $due_date->add( weeks => $span );
- $due_date->subtract( days => $due_date->day_of_week );
- my ($first) = sort @$weeks;
- $due_date->add( days => $first ) if $first;
+ next unless $checkday->ymd lt $date->Date;
}
- elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- weeks => $content->{'repeat-details-weekly-complete'} || 1 );
- return if $resolved->Date gt $date->ymd;
+
+ my $last_ticket;
+ if ( $content->{'last-ticket'} ) {
+ $last_ticket = RT::Ticket->new( RT->SystemUser );
+ $last_ticket->Load( $content->{'last-ticket'} );
}
- }
- elsif ( $content->{'repeat-type'} eq 'monthly' ) {
- if ( $content->{'repeat-details-monthly'} eq 'day' ) {
- my $day = $content->{'repeat-details-monthly-day-day'} || 1;
- return unless $day == $checkday->day_of_month;
- my $span = $content->{'repeat-details-monthly-day-month'} || 1;
- my $date = $checkday->clone;
- $date->subtract( months => $span );
- return unless CheckLastTicket( $date, $last_ticket );
+ $last_ticket ||= $repeat_ticket;
- $due_date->add( months => $span );
- }
- elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
- my $day = $content->{'repeat-details-monthly-week-week'} || 0;
- return unless $day == $checkday->day_of_week;
+ my $due_date = $checkday->clone;
- my $number = $content->{'repeat-details-monthly-week-number'} || 1;
- return
- unless $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
-
- my $span = $content->{'repeat-details-monthly-week-month'} || 1;
- my $date = $checkday->clone;
- $date->subtract( months => $span );
- return unless CheckLastTicket( $date, $last_ticket );
-
- $due_date->add( months => $span );
- $due_date->subtract( days => $due_date->day_of_month - 1 );
- $due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week ) {
- $due_date->add( days => $day - $due_date->day_of_week );
+ if ( $content->{'repeat-type'} eq 'daily' ) {
+ if ( $content->{'repeat-details-daily'} eq 'day' ) {
+ my $span = $content->{'repeat-details-daily-day'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( days => $span );
+ next unless CheckLastTicket( $date, $last_ticket );
+
+ $due_date->add( days => $span );
}
- elsif ( $day < $due_date->day_of_week ) {
- $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
+ return
+ unless $checkday->day_of_week >= 1
+ && $checkday->day_of_week <= 5;
+ if ( $checkday->day_of_week == 5 ) {
+ $due_date->add( days => 3 );
+ }
+ else {
+ $due_date->add( days => 1 );
+ }
}
+ elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ days => $content->{'repeat-details-daily-complete'} || 1 );
+ next if $resolved->Date gt $date->ymd;
+ }
+
}
- elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- months => $content->{'repeat-details-monthly-complete'} || 1 );
- return if $resolved->Date gt $date->ymd;
- }
- }
- elsif ( $content->{'repeat-type'} eq 'yearly' ) {
- if ( $content->{'repeat-details-yearly'} eq 'day' ) {
- my $day = $content->{'repeat-details-yearly-day-day'} || 1;
- return unless $day == $checkday->day_of_month;
-
- my $month = $content->{'repeat-details-yearly-day-month'} || 1;
- return unless $month == $checkday->month;
- $due_date->add( years => 1 );
+ elsif ( $content->{'repeat-type'} eq 'weekly' ) {
+ if ( $content->{'repeat-details-weekly'} eq 'week' ) {
+ my $span = $content->{'repeat-details-weekly-week'} || 1;
+ my $date = $checkday->clone;
+
+ # go to the end of the week
+ $date->subtract(
+ weeks => $span - 1,
+ days => $checkday->day_of_week
+ );
+ next unless CheckLastTicket( $date, $last_ticket );
+
+ my $weeks = $content->{'repeat-details-weekly-weeks'};
+ next unless $weeks;
+
+ $weeks = [$weeks] unless ref $weeks;
+ next unless grep { $_ == $checkday->day_of_week } @$weeks;
+
+ $due_date->add( weeks => $span );
+ $due_date->subtract( days => $due_date->day_of_week );
+ my ($first) = sort @$weeks;
+ $due_date->add( days => $first ) if $first;
+ }
+ elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ weeks => $content->{'repeat-details-weekly-complete'}
+ || 1 );
+ next if $resolved->Date gt $date->ymd;
+ }
}
- elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
- my $day = $content->{'repeat-details-yearly-week-week'} || 0;
- return unless $day == $checkday->day_of_week;
-
- my $month = $content->{'repeat-details-yearly-week-month'} || 1;
- return unless $month == $checkday->month;
+ elsif ( $content->{'repeat-type'} eq 'monthly' ) {
+ if ( $content->{'repeat-details-monthly'} eq 'day' ) {
+ my $day = $content->{'repeat-details-monthly-day-day'} || 1;
+ next unless $day == $checkday->day_of_month;
- my $number = $content->{'repeat-details-yearly-week-number'} || 1;
- return
- unless $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+ my $span = $content->{'repeat-details-monthly-day-month'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( months => $span );
+ next unless CheckLastTicket( $date, $last_ticket );
- $due_date->add( year => 1 );
- $due_date->subtract( days => $due_date->day_of_month - 1 );
- $due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week ) {
- $due_date->add( days => $day - $due_date->day_of_week );
+ $due_date->add( months => $span );
+ }
+ elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
+ my $day = $content->{'repeat-details-monthly-week-week'} || 0;
+ next unless $day == $checkday->day_of_week;
+
+ my $number = $content->{'repeat-details-monthly-week-number'}
+ || 1;
+ return
+ unless $number ==
+ int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+
+ my $span = $content->{'repeat-details-monthly-week-month'} || 1;
+ my $date = $checkday->clone;
+ $date->subtract( months => $span );
+ next unless CheckLastTicket( $date, $last_ticket );
+
+ $due_date->add( months => $span );
+ $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->add( weeks => $number - 1 );
+ if ( $day > $due_date->day_of_week ) {
+ $due_date->add( days => $day - $due_date->day_of_week );
+ }
+ elsif ( $day < $due_date->day_of_week ) {
+ $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ }
}
- elsif ( $day < $due_date->day_of_week ) {
- $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ months => $content->{'repeat-details-monthly-complete'}
+ || 1 );
+ next if $resolved->Date gt $date->ymd;
}
}
- elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- years => $content->{'repeat-details-yearly-complete'} || 1 );
- return
- if $resolved->Date gt $date->ymd;
+ elsif ( $content->{'repeat-type'} eq 'yearly' ) {
+ if ( $content->{'repeat-details-yearly'} eq 'day' ) {
+ my $day = $content->{'repeat-details-yearly-day-day'} || 1;
+ next unless $day == $checkday->day_of_month;
+
+ my $month = $content->{'repeat-details-yearly-day-month'} || 1;
+ next unless $month == $checkday->month;
+ $due_date->add( years => 1 );
+ }
+ elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
+ my $day = $content->{'repeat-details-yearly-week-week'} || 0;
+ next unless $day == $checkday->day_of_week;
+
+ my $month = $content->{'repeat-details-yearly-week-month'} || 1;
+ next unless $month == $checkday->month;
+
+ my $number = $content->{'repeat-details-yearly-week-number'}
+ || 1;
+ return
+ unless $number ==
+ int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+
+ $due_date->add( year => 1 );
+ $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->add( weeks => $number - 1 );
+ if ( $day > $due_date->day_of_week ) {
+ $due_date->add( days => $day - $due_date->day_of_week );
+ }
+ elsif ( $day < $due_date->day_of_week ) {
+ $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ }
+ }
+ elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
+ return
+ unless $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status );
+ my $resolved = $last_ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ $date->subtract(
+ years => $content->{'repeat-details-yearly-complete'}
+ || 1 );
+ return
+ if $resolved->Date gt $date->ymd;
+ }
}
- }
- # use RT::Date to work around the timezone issue
- my $starts = RT::Date->new( RT->SystemUser );
- $starts->Set( Format => 'unknown', Value => $checkday->ymd );
+ # use RT::Date to work around the timezone issue
+ my $starts = RT::Date->new( RT->SystemUser );
+ $starts->Set( Format => 'unknown', Value => $checkday->ymd );
- my $due = RT::Date->new( RT->SystemUser );
- $due->Set( Format => 'unknown', Value => $due_date->ymd );
+ my $due = RT::Date->new( RT->SystemUser );
+ $due->Set( Format => 'unknown', Value => $due_date->ymd );
- my ( $id, $txn, $msg ) = _RepeatTicket(
- $repeat_ticket,
- Starts => $starts->ISO,
- $due_date eq $checkday
- ? ()
- : ( Due => $due->ISO ),
- );
+ my ( $id, $txn, $msg ) = _RepeatTicket(
+ $repeat_ticket,
+ Starts => $starts->ISO,
+ $due_date eq $checkday
+ ? ()
+ : ( Due => $due->ISO ),
+ );
- if ($id) {
- $RT::Logger->info( "Repeated Ticket $id for " . $repeat_ticket->id );
- $content->{'repeat-occurrences'}++;
- $content->{'last-ticket'} = $id;
- $attr->SetContent($content);
- return ( $id, $txn, $msg );
- }
- else {
- $RT::Logger->error(
- "Failed to repeat ticket for " . $repeat_ticket->id . ": $msg" );
- return;
+ if ($id) {
+ $RT::Logger->info(
+ "Repeated Ticket $id for " . $repeat_ticket->id );
+ $content->{'repeat-occurrences'} += $id;
+ $content->{'last-ticket'} = $id;
+ push @{ $content->{'tickets'} }, $id;
+ }
+ else {
+ $RT::Logger->error( "Failed to repeat ticket for "
+ . $repeat_ticket->id
+ . ": $msg" );
+ next;
+ }
}
+
+ $attr->SetContent($content);
+ return @ids;
}
sub _RepeatTicket {
@@ -351,6 +385,150 @@ sub _RepeatTicket {
return $ticket->Create(%args);
}
+sub MaybeRepeatMore {
+ my $attr = shift;
+ my $content = $attr->Content;
+
+ my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
+ my $tickets = $content->{tickets} || [];
+ my $last_ticket = RT::Ticket->new( RT->SystemUser );
+ if ( $tickets->[-1] ) {
+ $last_ticket->Load($tickets->[-1]);
+ }
+
+ my $date = $last_ticket && $last_ticket->DueObj->Unix
+ ? DateTime->from_epoch(
+ epoch => $last_ticket->DueObj->Unix - 3600*24,
+ time_zone => RT->Config->Get('Timezone')
+ )
+ : DateTime->today( time_zone => RT->Config->Get('Timezone') );
+
+ @$tickets = grep {
+ my $t = RT::Ticket->new( RT->SystemUser );
+ $t->Load($_);
+ !$t->QueueObj->Lifecycle->IsInactive( $t->Status );
+ } @$tickets;
+
+ $content->{tickets} = $tickets;
+ $attr->SetContent( $content );
+
+ my @ids;
+ if ( $co_number > @$tickets ) {
+ my $total = $co_number - @$tickets;
+ my @dates;
+ if ( $content->{'repeat-type'} eq 'daily' ) {
+ if ( $content->{'repeat-details-daily'} eq 'day' ) {
+ my $span = $content->{'repeat-details-daily-day'} || 1;
+ for ( 1 .. $total ) {
+ $date->add( days => 1 );
+ push @dates, $date->clone;
+ }
+ }
+ elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
+ while ( @dates < $total ) {
+ $date->add( days => 1 );
+ push @dates, $date->clone
+ if $date->day_of_week >= 1 && $date->day_of_week <= 5;
+ }
+ }
+ }
+ elsif ( $content->{'repeat-type'} eq 'weekly' ) {
+ if ( $content->{'repeat-details-weekly'} eq 'week' ) {
+ my $weeks = $content->{'repeat-details-weekly-weeks'};
+ if ($weeks) {
+ while ( @dates < $total ) {
+ $date->add( days => 1 );
+ $weeks = [$weeks] unless ref $weeks;
+ if ( grep { $date->day_of_week == $_ } @$weeks ) {
+
+ push @dates, $date->clone;
+ }
+
+ if ( $date->day_of_week == 0
+ && $content->{'repeat-details-weekly-week'} )
+ {
+ $date->add( weeks =>
+ $content->{'repeat-details-weekly-week'} -
+ 1 );
+ }
+ }
+ }
+ }
+ }
+ elsif ( $content->{'repeat-type'} eq 'monthly' ) {
+ if ( $content->{'repeat-details-monthly'} eq 'day' ) {
+ my $span = $content->{'repeat-details-monthly-day-month'} || 1;
+ $date->set( day => $content->{'repeat-details-monthly-day-day'}
+ || 1 );
+
+ for ( 1 .. $total ) {
+ $date->add( months => $span );
+ push @dates, $date->clone;
+ }
+ }
+ elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
+ my $span = $content->{'repeat-details-monthly-week-month'} || 1;
+ my $number = $content->{'repeat-details-monthly-week-number'}
+ || 1;
+ my $day = $content->{'repeat-details-monthly-week-day'} || 1;
+
+ for ( 1 .. $total ) {
+ $date->add( months => $span );
+ $date->subtract( days => $date->day_of_month - 1 );
+ $date->add( weeks => $number - 1 );
+
+ if ( $day > $date->day_of_week ) {
+ $date->add( days => $day - $date->day_of_week );
+ }
+ elsif ( $day < $date->day_of_week ) {
+ $date->add( days => 7 + $day - $date->day_of_week );
+ }
+ push @dates, $date->clone;
+ }
+ }
+ }
+ elsif ( $content->{'repeat-type'} eq 'yearly' ) {
+ if ( $content->{'repeat-details-yearly'} eq 'day' ) {
+ $date->set( day => $content->{'repeat-details-yearly-day-day'}
+ || 1 );
+ $date->set(
+ month => $content->{'repeat-details-yearly-day-month'}
+ || 1 );
+ for ( 1 .. $total ) {
+ $date->add( years => 1 );
+ push @dates, $date->clone;
+ }
+ }
+ elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
+ $date->set(
+ month => $content->{'repeat-details-yearly-week-month'}
+ || 1 );
+
+ my $number = $content->{'repeat-details-yearly-week-number'}
+ || 1;
+ my $day = $content->{'repeat-details-yearly-week-day'} || 1;
+
+ for ( 1 .. $total ) {
+ $date->add( years => 1 );
+ $date->subtract( days => $date->day_of_month - 1 );
+ $date->add( weeks => $number - 1 );
+ if ( $day > $date->day_of_week ) {
+ $date->add( days => $day - $date->day_of_week );
+ }
+ elsif ( $day < $date->day_of_week ) {
+ $date->add( days => 7 + $day - $date->day_of_week );
+ }
+ push @dates, $date->clone;
+ }
+ }
+ }
+
+ for my $date (@dates) {
+ RepeatTicket( $attr, @dates );
+ }
+ }
+}
+
sub CheckLastTicket {
my $date = shift;
my $last_ticket = shift;
@@ -394,8 +572,13 @@ To install this module, run the following commands:
add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
+ Set( $RepeatTicketCoexistentNumber, 1 );
Set( @Plugins, qw(... RT::Extension::RepeatTicket) );
+C<$RepeatTicketCoexistentNumber> only works for repeats that don't reply on
+the completion of previous tickets, in which case the config will be simply
+ignored.
+
=head1 AUTHOR
sunnavy, <sunnavy at bestpractical.com>
commit 51ccc117c2065a7711283d790166364641e02aee
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 05:13:17 2012 +0800
fix the MIMEObj sent to RT::Ticket->Create()
there is a very odd case that a simple
$args{MIMEObj} = $attachment->ContentAsMIME( Children => 1 ) );
doesn't work, but works if we reparse it with RT::EmailParser
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 7070789..ea6aa9b 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -369,17 +369,19 @@ sub _RepeatTicket {
$txns->OrderBy( FIELD => 'id', ORDER => 'ASC' );
$txns->RowsPerPage(1);
my $txn = $txns->First;
-
- my $atts = RT::Attachments->new($RT::SystemUser);
+ my $atts = RT::Attachments->new(RT->SystemUser);
$atts->OrderBy( FIELD => 'id', ORDER => 'ASC' );
$atts->Limit( FIELD => 'TransactionId', VALUE => $txn->id );
$atts->Limit( FIELD => 'Parent', VALUE => 0 );
- $atts->RowsPerPage(1);
-
my $top = $atts->First;
- if ($top) {
- $args{MIMEObj} = $top->ContentAsMIME( Children => 1 );
- }
+
+ # XXX no idea why this doesn't work:
+ # $args{MIMEObj} = $top->ContentAsMIME( Children => 1 ) );
+
+ my $parser = RT::EmailParser->new( RT->SystemUser );
+ $args{MIMEObj} =
+ $parser->ParseMIMEEntityFromScalar(
+ $top->ContentAsMIME( Children => 1 )->as_string );
my $ticket = RT::Ticket->new( RT->SystemUser );
return $ticket->Create(%args);
commit 7329d820865b55d671e6c214475b7301a91d6d16
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 05:17:44 2012 +0800
it's more right to use old ticket's current user
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index ea6aa9b..08eeb39 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -383,7 +383,7 @@ sub _RepeatTicket {
$parser->ParseMIMEEntityFromScalar(
$top->ContentAsMIME( Children => 1 )->as_string );
- my $ticket = RT::Ticket->new( RT->SystemUser );
+ my $ticket = RT::Ticket->new( $repeat_ticket->CurrentUser );
return $ticket->Create(%args);
}
commit e554ecd7a8e86d046cb704ccc486c5fa3cd2b2ed
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 05:20:49 2012 +0800
typo
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 08eeb39..f2bc5d5 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -577,8 +577,8 @@ add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
Set( $RepeatTicketCoexistentNumber, 1 );
Set( @Plugins, qw(... RT::Extension::RepeatTicket) );
-C<$RepeatTicketCoexistentNumber> only works for repeats that don't reply on
-the completion of previous tickets, in which case the config will be simply
+C<$RepeatTicketCoexistentNumber> only works for repeats that don't rely on the
+completion of previous tickets, in which case the config will be simply
ignored.
=head1 AUTHOR
commit 0fc0db9472379efba73c5c693bfe9df7cd2f5155
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 05:39:44 2012 +0800
return repeated ids so we can show them in script
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
index 0cf4efa..46600fb 100755
--- a/bin/rt-repeat-ticket
+++ b/bin/rt-repeat-ticket
@@ -27,7 +27,13 @@ $attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
use RT::Extension::RepeatTicket;
my $today = DateTime->today( time_zone => RT->Config->Get('Timezone') );
while ( my $attr = $attrs->Next ) {
- RT::Extension::RepeatTicket::Run( $attr, $today );
+ next unless $attr->Content->{'repeat-enabled'};
+ $RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
+ my @ids = RT::Extension::RepeatTicket::Run( $attr, $today );
+ if ( @ids ) {
+ $RT::Logger->info(
+ 'Repeated ticket ' . $attr->Object->id . ': ' . join ', ', @ids );
+ }
}
__END__
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index f2bc5d5..684273a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -55,8 +55,9 @@ sub Run {
my $checkday = shift
|| DateTime->today( time_zone => RT->Config->Get('Timezone') );
- RepeatTicket( $attr, $checkday );
- MaybeRepeatMore( $attr ); # create more to meet the coexistent number
+ my @ids = RepeatTicket( $attr, $checkday );
+ push @ids, MaybeRepeatMore( $attr ); # create more to meet the coexistent number
+ return @ids;
}
sub RepeatTicket {
@@ -284,10 +285,11 @@ sub RepeatTicket {
if ($id) {
$RT::Logger->info(
- "Repeated Ticket $id for " . $repeat_ticket->id );
+ "Repeated ticket " . $repeat_ticket->id . ": $id" );
$content->{'repeat-occurrences'} += $id;
$content->{'last-ticket'} = $id;
push @{ $content->{'tickets'} }, $id;
+ push @ids, $id;
}
else {
$RT::Logger->error( "Failed to repeat ticket for "
@@ -526,9 +528,10 @@ sub MaybeRepeatMore {
}
for my $date (@dates) {
- RepeatTicket( $attr, @dates );
+ push @ids, RepeatTicket( $attr, @dates );
}
}
+ return @ids;
}
sub CheckLastTicket {
commit d1e63c0816eff74a3c54c7f0c005633334e72fe2
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 08:47:31 2012 +0800
week number could be 0, also fix precedence
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 669a2f5..ce2ae00 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -93,9 +93,9 @@ size="4" value="<% $ARGSRef->{'repeat-details-weekly-week'} || 1 %>" /> <&|/l&>w
<td>
<input name="repeat-details-weekly-weeks" type="checkbox" value="<%
$number %>"
-% if ( $ARGSRef->{'repeat-details-weekly-weeks'} &&
+% if ( defined $ARGSRef->{'repeat-details-weekly-weeks'} && (
% ( ref $ARGSRef->{'repeat-details-weekly-weeks'} && grep { $_ == $number }
-% @{$ARGSRef->{'repeat-details-weekly-weeks'}} ||
+% @{$ARGSRef->{'repeat-details-weekly-weeks'}} ) ||
% ( $ARGSRef->{'repeat-details-weekly-weeks'} == $number ) ) ) {
checked="checked"
% }
commit 90fe38e71dbbbe30003a10b2ab805a714b68bcd1
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 08:52:20 2012 +0800
default value for maybe-not-sent checkboxes
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 684273a..a6c7ad6 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -28,7 +28,11 @@ sub SetRepeatAttribute {
my $ticket = shift;
return 0 unless $ticket;
my %args = @_;
- my %repeat_args = map { $_ => $args{$_} } grep { /^repeat/ } keys %args;
+ my %repeat_args = (
+ 'repeat-enabled' => undef,
+ 'repeat-details-weekly-week' => undef,
+ map { $_ => $args{$_} } grep { /^repeat/ } keys %args
+ );
my ( $old_attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
my %old;
commit f49be805dd5fde02ccd20cbee211f3e6259dfef5
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 08:54:03 2012 +0800
we should update tickets to original ticket id only when creating the original ticket
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index a6c7ad6..909b12b 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -17,7 +17,7 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
my %args = @_;
my ( $ticket, @actions ) = $old_create_ticket->(@_);
if ( $ticket && $args{'repeat-enabled'} ) {
- my ( $attr ) = SetRepeatAttribute( $ticket, %args );
+ my ( $attr ) = SetRepeatAttribute( $ticket, %args, tickets => [ $ticket->id ] );
MaybeRepeatMore( $attr );
}
return ( $ticket, @actions );
@@ -38,7 +38,7 @@ sub SetRepeatAttribute {
my %old;
%old = %{$old_attr->Content} if $old_attr;
- my $content = { %old, %repeat_args, tickets => [ $ticket->id ] };
+ my $content = { %old, %repeat_args };
$ticket->SetAttribute(
Name => 'RepeatTicketSettings',
commit 2034216099f349761229ccfbbd85155a69cd3f64
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 09:09:12 2012 +0800
use last-ticket as it always exists
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 909b12b..bf678bb 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -17,7 +17,13 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
my %args = @_;
my ( $ticket, @actions ) = $old_create_ticket->(@_);
if ( $ticket && $args{'repeat-enabled'} ) {
- my ( $attr ) = SetRepeatAttribute( $ticket, %args, tickets => [ $ticket->id ] );
+ my ($attr) = SetRepeatAttribute(
+ $ticket,
+ 'tickets' => [ $ticket->id ],
+ 'last-ticket' => $ticket->id,
+ map { $_ => $args{$_} } grep { /^repeat/ } keys %args
+ );
+ use Data::Dumper;
MaybeRepeatMore( $attr );
}
return ( $ticket, @actions );
@@ -31,7 +37,7 @@ sub SetRepeatAttribute {
my %repeat_args = (
'repeat-enabled' => undef,
'repeat-details-weekly-week' => undef,
- map { $_ => $args{$_} } grep { /^repeat/ } keys %args
+ %args
);
my ( $old_attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
@@ -100,13 +106,8 @@ sub RepeatTicket {
next unless $checkday->ymd lt $date->Date;
}
- my $last_ticket;
- if ( $content->{'last-ticket'} ) {
- $last_ticket = RT::Ticket->new( RT->SystemUser );
- $last_ticket->Load( $content->{'last-ticket'} );
- }
-
- $last_ticket ||= $repeat_ticket;
+ my $last_ticket = RT::Ticket->new( RT->SystemUser );
+ $last_ticket->Load( $content->{'last-ticket'} );
my $due_date = $checkday->clone;
@@ -399,14 +400,14 @@ sub MaybeRepeatMore {
my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
my $tickets = $content->{tickets} || [];
+
my $last_ticket = RT::Ticket->new( RT->SystemUser );
- if ( $tickets->[-1] ) {
- $last_ticket->Load($tickets->[-1]);
- }
+ $last_ticket->Load( $content->{'last-ticket'} );
- my $date = $last_ticket && $last_ticket->DueObj->Unix
+ my $date =
+ $last_ticket->DueObj->Unix
? DateTime->from_epoch(
- epoch => $last_ticket->DueObj->Unix - 3600*24,
+ epoch => $last_ticket->DueObj->Unix - 3600 * 24,
time_zone => RT->Config->Get('Timezone')
)
: DateTime->today( time_zone => RT->Config->Get('Timezone') );
commit 6e8528d6f992abca75935603c0e0d4bb348909cb
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 09:09:45 2012 +0800
typo
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index bf678bb..27c31fa 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -291,7 +291,7 @@ sub RepeatTicket {
if ($id) {
$RT::Logger->info(
"Repeated ticket " . $repeat_ticket->id . ": $id" );
- $content->{'repeat-occurrences'} += $id;
+ $content->{'repeat-occurrences'}++;
$content->{'last-ticket'} = $id;
push @{ $content->{'tickets'} }, $id;
push @ids, $id;
commit 7e9a10637c10732c69d590a345538a0f14fc7188
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 09:20:06 2012 +0800
cleanup
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 27c31fa..6a8f78d 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -23,7 +23,6 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
'last-ticket' => $ticket->id,
map { $_ => $args{$_} } grep { /^repeat/ } keys %args
);
- use Data::Dumper;
MaybeRepeatMore( $attr );
}
return ( $ticket, @actions );
commit fb0172a4123b922ad0307021b19414323648824d
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 09:23:49 2012 +0800
again, weeks could be 0
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 6a8f78d..943fddc 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -155,7 +155,7 @@ sub RepeatTicket {
next unless CheckLastTicket( $date, $last_ticket );
my $weeks = $content->{'repeat-details-weekly-weeks'};
- next unless $weeks;
+ next unless defined $weeks;
$weeks = [$weeks] unless ref $weeks;
next unless grep { $_ == $checkday->day_of_week } @$weeks;
@@ -443,12 +443,11 @@ sub MaybeRepeatMore {
elsif ( $content->{'repeat-type'} eq 'weekly' ) {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
my $weeks = $content->{'repeat-details-weekly-weeks'};
- if ($weeks) {
+ if (defined $weeks) {
+ $weeks = [$weeks] unless ref $weeks;
while ( @dates < $total ) {
$date->add( days => 1 );
- $weeks = [$weeks] unless ref $weeks;
if ( grep { $date->day_of_week == $_ } @$weeks ) {
-
push @dates, $date->clone;
}
commit 667614e7f82323531354f451a7d85c45826cdee0
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 09:25:54 2012 +0800
check carefully as we have while loop
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 943fddc..ff11937 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -443,7 +443,7 @@ sub MaybeRepeatMore {
elsif ( $content->{'repeat-type'} eq 'weekly' ) {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
my $weeks = $content->{'repeat-details-weekly-weeks'};
- if (defined $weeks) {
+ if (defined $weeks && $weeks >= 0 && $weeks <= 6 ) {
$weeks = [$weeks] unless ref $weeks;
while ( @dates < $total ) {
$date->add( days => 1 );
commit d410713d809923e119d72b5371a5132a970f230e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 10:07:22 2012 +0800
debug log
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index ff11937..651b2df 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -77,8 +77,10 @@ sub RepeatTicket {
my $content = $attr->Content;
return unless $content->{'repeat-enabled'};
+ my $repeat_ticket = $attr->Object;
+
for my $checkday (@checkdays) {
- my $repeat_ticket = $attr->Object;
+ $RT::Logger->debug( 'checking ' . $checkday->ymd );
if ( $content->{'repeat-start-date'} ) {
my $date = RT::Date->new( RT->SystemUser );
@@ -86,14 +88,20 @@ sub RepeatTicket {
Format => 'unknown',
Value => $content->{'repeat-start-date'},
);
- next unless $checkday->ymd ge $date->Date;
+ if ( $checkday->ymd lt $date->Date ) {
+ $RT::Logger->debug( 'Failed repeat-start-date check' );
+ next;
+ }
}
if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'number' )
{
- return
- unless $content->{'repeat-end-number'} >
- $content->{'repeat-occurrences'};
+ if ( $content->{'repeat-end-number'} >=
+ $content->{'repeat-occurrences'} )
+ {
+ $RT::Logger->debug( 'Failed repeat-end-number check' );
+ last;
+ }
}
if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'date' ) {
@@ -102,7 +110,11 @@ sub RepeatTicket {
Format => 'unknown',
Value => $content->{'repeat-end-date'},
);
- next unless $checkday->ymd lt $date->Date;
+
+ if ( $checkday->ymd gt $date->Date ) {
+ $RT::Logger->debug( 'Failed repeat-end-date check' );
+ next;
+ }
}
my $last_ticket = RT::Ticket->new( RT->SystemUser );
@@ -115,14 +127,22 @@ sub RepeatTicket {
my $span = $content->{'repeat-details-daily-day'} || 1;
my $date = $checkday->clone;
$date->subtract( days => $span );
- next unless CheckLastTicket( $date, $last_ticket );
+
+ unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ $RT::Logger->debug('Failed last-ticket date check');
+ next;
+ }
$due_date->add( days => $span );
}
elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
- return
- unless $checkday->day_of_week >= 1
- && $checkday->day_of_week <= 5;
+ unless ( $checkday->day_of_week >= 1
+ && $checkday->day_of_week <= 5 )
+ {
+ $RT::Logger->debug('Failed weekday check');
+ next;
+ }
+
if ( $checkday->day_of_week == 5 ) {
$due_date->add( days => 3 );
}
@@ -131,14 +151,25 @@ sub RepeatTicket {
}
}
elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
+ unless (
+ $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status
+ )
+ )
+ {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
+
my $resolved = $last_ticket->ResolvedObj;
my $date = $checkday->clone;
$date->subtract(
days => $content->{'repeat-details-daily-complete'} || 1 );
- next if $resolved->Date gt $date->ymd;
+
+ if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
+ $RT::Logger->debug('Failed complete date check');
+ next;
+ }
}
}
@@ -152,13 +183,23 @@ sub RepeatTicket {
weeks => $span - 1,
days => $checkday->day_of_week
);
- next unless CheckLastTicket( $date, $last_ticket );
+ unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ $RT::Logger->debug('Failed last-ticket date check');
+ next;
+ }
my $weeks = $content->{'repeat-details-weekly-weeks'};
- next unless defined $weeks;
+
+ unless ( defined $weeks ) {
+ $RT::Logger->debug('Failed weeks defined check');
+ next;
+ }
$weeks = [$weeks] unless ref $weeks;
- next unless grep { $_ == $checkday->day_of_week } @$weeks;
+ unless ( grep { $_ == $checkday->day_of_week } @$weeks ) {
+ $RT::Logger->debug('Failed weeks check');
+ next;
+ }
$due_date->add( weeks => $span );
$due_date->subtract( days => $due_date->day_of_week );
@@ -166,43 +207,68 @@ sub RepeatTicket {
$due_date->add( days => $first ) if $first;
}
elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
+ unless (
+ $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status
+ )
+ )
+ {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
my $resolved = $last_ticket->ResolvedObj;
my $date = $checkday->clone;
$date->subtract(
weeks => $content->{'repeat-details-weekly-complete'}
|| 1 );
- next if $resolved->Date gt $date->ymd;
+ if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
+ $RT::Logger->debug('Failed complete date check');
+ next;
+ }
}
}
elsif ( $content->{'repeat-type'} eq 'monthly' ) {
if ( $content->{'repeat-details-monthly'} eq 'day' ) {
my $day = $content->{'repeat-details-monthly-day-day'} || 1;
- next unless $day == $checkday->day_of_month;
+ unless ( $day == $checkday->day_of_month ) {
+ $RT::Logger->debug('Failed day of month check');
+ next;
+ }
my $span = $content->{'repeat-details-monthly-day-month'} || 1;
my $date = $checkday->clone;
$date->subtract( months => $span );
- next unless CheckLastTicket( $date, $last_ticket );
+ unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ $RT::Logger->debug('Failed last-ticket date check');
+ next;
+ }
$due_date->add( months => $span );
}
elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
my $day = $content->{'repeat-details-monthly-week-week'} || 0;
- next unless $day == $checkday->day_of_week;
+ unless ( $day == $checkday->day_of_week ) {
+ $RT::Logger->debug('Failed day of week check');
+ next;
+ }
my $number = $content->{'repeat-details-monthly-week-number'}
|| 1;
- return
- unless $number ==
- int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+
+ unless (
+ $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1 )
+ {
+ $RT::Logger->debug('Failed week number check');
+ next;
+ }
my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $date = $checkday->clone;
$date->subtract( months => $span );
- next unless CheckLastTicket( $date, $last_ticket );
+ unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ $RT::Logger->debug('Failed last-ticket date check');
+ next;
+ }
$due_date->add( months => $span );
$due_date->subtract( days => $due_date->day_of_month - 1 );
@@ -215,38 +281,61 @@ sub RepeatTicket {
}
}
elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
+ unless (
+ $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status
+ )
+ )
+ {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
my $resolved = $last_ticket->ResolvedObj;
my $date = $checkday->clone;
$date->subtract(
months => $content->{'repeat-details-monthly-complete'}
|| 1 );
- next if $resolved->Date gt $date->ymd;
+ if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
+ $RT::Logger->debug('Failed complete date check');
+ next;
+ }
}
}
elsif ( $content->{'repeat-type'} eq 'yearly' ) {
if ( $content->{'repeat-details-yearly'} eq 'day' ) {
my $day = $content->{'repeat-details-yearly-day-day'} || 1;
- next unless $day == $checkday->day_of_month;
+ unless ( $day == $checkday->day_of_month ) {
+ $RT::Logger->debug('Failed day of month check');
+ next;
+ }
my $month = $content->{'repeat-details-yearly-day-month'} || 1;
- next unless $month == $checkday->month;
+ unless ( $month == $checkday->month ) {
+ $RT::Logger->debug('Failed month check');
+ next;
+ }
$due_date->add( years => 1 );
}
elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
my $day = $content->{'repeat-details-yearly-week-week'} || 0;
- next unless $day == $checkday->day_of_week;
+ unless ( $day == $checkday->day_of_week ) {
+ $RT::Logger->debug('Failed day of week check');
+ next;
+ }
my $month = $content->{'repeat-details-yearly-week-month'} || 1;
- next unless $month == $checkday->month;
+ unless ( $month == $checkday->month ) {
+ $RT::Logger->debug('Failed month check');
+ next;
+ }
my $number = $content->{'repeat-details-yearly-week-number'}
|| 1;
- return
- unless $number ==
- int( ( $checkday->day_of_month - 1 ) / 7 ) + 1;
+ unless ( $number ==
+ int( ( $checkday->day_of_month - 1 ) / 7 ) + 1 ) {
+ $RT::Logger->debug('Failed week number check');
+ next;
+ }
$due_date->add( year => 1 );
$due_date->subtract( days => $due_date->day_of_month - 1 );
@@ -259,16 +348,24 @@ sub RepeatTicket {
}
}
elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
- return
- unless $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status );
+ unless (
+ $last_ticket->QueueObj->Lifecycle->IsInactive(
+ $last_ticket->Status
+ )
+ )
+ {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
my $resolved = $last_ticket->ResolvedObj;
my $date = $checkday->clone;
$date->subtract(
years => $content->{'repeat-details-yearly-complete'}
|| 1 );
- return
- if $resolved->Date gt $date->ymd;
+ if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
+ $RT::Logger->debug('Failed complete date check');
+ next;
+ }
}
}
commit 9ec61390000fbe09c95c4f80f6f918899f94a5b4
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 10:15:06 2012 +0800
use consistent logic in RepeatTicket and MaybeRepeatMore
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 651b2df..fec1c5e 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -542,8 +542,9 @@ sub MaybeRepeatMore {
my $weeks = $content->{'repeat-details-weekly-weeks'};
if (defined $weeks && $weeks >= 0 && $weeks <= 6 ) {
$weeks = [$weeks] unless ref $weeks;
+ $date->add( weeks => 1 );
+ $date->subtract( days => $date->day_of_week );
while ( @dates < $total ) {
- $date->add( days => 1 );
if ( grep { $date->day_of_week == $_ } @$weeks ) {
push @dates, $date->clone;
}
@@ -555,6 +556,7 @@ sub MaybeRepeatMore {
$content->{'repeat-details-weekly-week'} -
1 );
}
+ $date->add( days => 1 );
}
}
}
commit e4c19ca90b330eb90948ce783535afe2db43a7d5
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 10:55:24 2012 +0800
'RepeatTicket' doesn't take ticket argument, so better named as 'Repeat'
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index fec1c5e..aba6e87 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -64,12 +64,12 @@ sub Run {
my $checkday = shift
|| DateTime->today( time_zone => RT->Config->Get('Timezone') );
- my @ids = RepeatTicket( $attr, $checkday );
+ my @ids = Repeat( $attr, $checkday );
push @ids, MaybeRepeatMore( $attr ); # create more to meet the coexistent number
return @ids;
}
-sub RepeatTicket {
+sub Repeat {
my $attr = shift;
my @checkdays = @_;
my @ids;
@@ -630,7 +630,7 @@ sub MaybeRepeatMore {
}
for my $date (@dates) {
- push @ids, RepeatTicket( $attr, @dates );
+ push @ids, Repeat( $attr, @dates );
}
}
return @ids;
commit 1f852bf314137405b2108e17d9e1f3081b2bb823
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 11:43:03 2012 +0800
fix the logic we find next date
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index aba6e87..f192259 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -8,6 +8,7 @@ our $VERSION = "0.01";
use RT::Interface::Web;
use DateTime;
use RT::Date;
+use List::MoreUtils qw/after/;
my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
{
@@ -126,9 +127,8 @@ sub Repeat {
if ( $content->{'repeat-details-daily'} eq 'day' ) {
my $span = $content->{'repeat-details-daily-day'} || 1;
my $date = $checkday->clone;
- $date->subtract( days => $span );
- unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'day', $span ) ) {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -178,12 +178,7 @@ sub Repeat {
my $span = $content->{'repeat-details-weekly-week'} || 1;
my $date = $checkday->clone;
- # go to the end of the week
- $date->subtract(
- weeks => $span - 1,
- days => $checkday->day_of_week
- );
- unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'week', $span ) ) {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -201,10 +196,17 @@ sub Repeat {
next;
}
- $due_date->add( weeks => $span );
+ @$weeks = sort @$weeks;
$due_date->subtract( days => $due_date->day_of_week );
- my ($first) = sort @$weeks;
- $due_date->add( days => $first ) if $first;
+
+ my ($after) = after { $_ == $date->day_of_week } @$weeks;
+ if ($after) {
+ $due_date->add( days => $after );
+ }
+ else {
+ $due_date->add( weeks => $span );
+ $due_date->add( days => $weeks->[0] );
+ }
}
elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
unless (
@@ -237,8 +239,7 @@ sub Repeat {
my $span = $content->{'repeat-details-monthly-day-month'} || 1;
my $date = $checkday->clone;
- $date->subtract( months => $span );
- unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'month', $span ) ) {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -264,8 +265,7 @@ sub Repeat {
my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $date = $checkday->clone;
- $date->subtract( months => $span );
- unless ( CheckLastTicket( $date, $last_ticket ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'month', $span ) ) {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -525,7 +525,7 @@ sub MaybeRepeatMore {
if ( $content->{'repeat-details-daily'} eq 'day' ) {
my $span = $content->{'repeat-details-daily-day'} || 1;
for ( 1 .. $total ) {
- $date->add( days => 1 );
+ $date->add( days => $span );
push @dates, $date->clone;
}
}
@@ -540,23 +540,23 @@ sub MaybeRepeatMore {
elsif ( $content->{'repeat-type'} eq 'weekly' ) {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
my $weeks = $content->{'repeat-details-weekly-weeks'};
- if (defined $weeks && $weeks >= 0 && $weeks <= 6 ) {
+ if (defined $weeks ) {
$weeks = [$weeks] unless ref $weeks;
- $date->add( weeks => 1 );
- $date->subtract( days => $date->day_of_week );
- while ( @dates < $total ) {
- if ( grep { $date->day_of_week == $_ } @$weeks ) {
- push @dates, $date->clone;
- }
-
- if ( $date->day_of_week == 0
- && $content->{'repeat-details-weekly-week'} )
- {
- $date->add( weeks =>
- $content->{'repeat-details-weekly-week'} -
- 1 );
+ if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
+ while ( @dates < $total ) {
+ $date->add( days => 1 );
+ if ( grep { $date->day_of_week == $_ } @$weeks ) {
+ push @dates, $date->clone;
+ }
+
+ if ( $date->day_of_week == 0
+ && $content->{'repeat-details-weekly-week'} )
+ {
+ $date->add( weeks =>
+ $content->{'repeat-details-weekly-week'} -
+ 1 );
+ }
}
- $date->add( days => 1 );
}
}
}
@@ -639,6 +639,9 @@ sub MaybeRepeatMore {
sub CheckLastTicket {
my $date = shift;
my $last_ticket = shift;
+ my $type = shift;
+ my $span = shift || 1;
+
if ( $last_ticket->DueObj->Unix ) {
my $due = $last_ticket->DueObj;
$due->AddDays(-1);
@@ -650,7 +653,67 @@ sub CheckLastTicket {
}
}
- if ( $date->ymd ge $last_ticket->CreatedObj->Date( Timezone => 'user' ) ) {
+ my $created_str = $last_ticket->CreatedObj->Date( Timezone => 'user' );
+ my $created = DateTime->from_epoch(
+ epoch => $last_ticket->CreatedObj->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+
+ my $check = $date->clone();
+
+ if ( $type eq 'day' ) {
+ $check->subtract( days => $span );
+ }
+ elsif ( $type eq 'week' ) {
+ my $created_week_start = $created->clone->subtract( days => $created->day_of_week );
+ my $check_week_start = $check->clone->subtract( days => $created->day_of_week );
+
+ return 0 unless $check_week_start >= $created_week_start;
+
+ if ( $check_week_start == $created_week_start ) {
+ if ( $check->day_of_week > $created->day_of_week ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+ }
+
+ return 1 if $span == 1;
+
+ if ( ( $check_week_start->epoch - $created_week_start->epoch )
+ % ( $span * 24 * 3600 * 7 ) )
+ {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+ elsif ( $type eq 'month' ) {
+ my $created_month_start = $created->clone->set( day => 1 );
+ my $check_month_start = $check->clone->set( day => 1 );
+
+ return 0 unless $check_month_start > $created_month_start;
+ return 1 if $span == 1;
+
+ if (
+ (
+ $check->year * 12 +
+ $check->month -
+ $created->year * 12 -
+ $created->month
+ ) % $span
+ )
+ {
+ return 0;
+ }
+ else {
+ return 1;
+ }
+ }
+
+ if ( $check->ymd ge $created->ymd ) {
return 1;
}
else {
commit 3b3d9761a254c36d6f6fe0ce594f66abff0ed3f1
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 11:54:54 2012 +0800
typo
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index ce2ae00..f1697db 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -124,7 +124,7 @@ $number %>"
<td>
<input name="repeat-details-monthly" type="radio" value="day" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'day' ? 'checked="checked"' : '' |n %> /><&|/l&>Day</&>
<input name="repeat-details-monthly-day-day" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day'} || 1 %>" /> <&|/l&>of every</&>
- <input name="repeat-details-monthly-day-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-month'} || 1 %>" /> <&|/l&>month(s)</&>
+ <input name="repeat-details-monthly-day-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day-month'} || 1 %>" /> <&|/l&>month(s)</&>
</td>
</tr>
<tr>
commit 29676a018404f3ddb9f1b658ce7ea445845c4d85
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 13:55:18 2012 +0800
typo and use DateTime->truncate
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index f192259..5838615 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -35,8 +35,8 @@ sub SetRepeatAttribute {
return 0 unless $ticket;
my %args = @_;
my %repeat_args = (
- 'repeat-enabled' => undef,
- 'repeat-details-weekly-week' => undef,
+ 'repeat-enabled' => undef,
+ 'repeat-details-weekly-weeks' => undef,
%args
);
@@ -197,7 +197,7 @@ sub Repeat {
}
@$weeks = sort @$weeks;
- $due_date->subtract( days => $due_date->day_of_week );
+ $due_date->truncate( to => 'week' );
my ($after) = after { $_ == $date->day_of_week } @$weeks;
if ($after) {
@@ -271,7 +271,7 @@ sub Repeat {
}
$due_date->add( months => $span );
- $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->truncate( to => 'month' );
$due_date->add( weeks => $number - 1 );
if ( $day > $due_date->day_of_week ) {
$due_date->add( days => $day - $due_date->day_of_week );
@@ -338,7 +338,7 @@ sub Repeat {
}
$due_date->add( year => 1 );
- $due_date->subtract( days => $due_date->day_of_month - 1 );
+ $due_date->truncate( to => 'month' );
$due_date->add( weeks => $number - 1 );
if ( $day > $due_date->day_of_week ) {
$due_date->add( days => $day - $due_date->day_of_week );
@@ -539,22 +539,24 @@ sub MaybeRepeatMore {
}
elsif ( $content->{'repeat-type'} eq 'weekly' ) {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
+ my $span = $content->{'repeat-details-weekly-week'} || 1;
my $weeks = $content->{'repeat-details-weekly-weeks'};
if (defined $weeks ) {
$weeks = [$weeks] unless ref $weeks;
+
if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
+ $date->add( weeks => $span );
+ $date->truncate( to => 'week' );
+
while ( @dates < $total ) {
- $date->add( days => 1 );
if ( grep { $date->day_of_week == $_ } @$weeks ) {
push @dates, $date->clone;
}
- if ( $date->day_of_week == 0
- && $content->{'repeat-details-weekly-week'} )
- {
- $date->add( weeks =>
- $content->{'repeat-details-weekly-week'} -
- 1 );
+ $date->add( days => 1 );
+
+ if ( $date->day_of_week == 0 ) {
+ $date->add( weeks => $span );
}
}
}
@@ -580,7 +582,7 @@ sub MaybeRepeatMore {
for ( 1 .. $total ) {
$date->add( months => $span );
- $date->subtract( days => $date->day_of_month - 1 );
+ $date->truncate( to => 'month' );
$date->add( weeks => $number - 1 );
if ( $day > $date->day_of_week ) {
@@ -616,7 +618,7 @@ sub MaybeRepeatMore {
for ( 1 .. $total ) {
$date->add( years => 1 );
- $date->subtract( days => $date->day_of_month - 1 );
+ $date->truncate( to => 'month' );
$date->add( weeks => $number - 1 );
if ( $day > $date->day_of_week ) {
$date->add( days => $day - $date->day_of_week );
@@ -653,31 +655,28 @@ sub CheckLastTicket {
}
}
- my $created_str = $last_ticket->CreatedObj->Date( Timezone => 'user' );
my $created = DateTime->from_epoch(
epoch => $last_ticket->CreatedObj->Unix,
time_zone => RT->Config->Get('Timezone'),
);
+ $created->truncate( to => 'day' );
my $check = $date->clone();
if ( $type eq 'day' ) {
$check->subtract( days => $span );
+ if ( $check->ymd ge $created->ymd ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
}
elsif ( $type eq 'week' ) {
- my $created_week_start = $created->clone->subtract( days => $created->day_of_week );
- my $check_week_start = $check->clone->subtract( days => $created->day_of_week );
+ my $created_week_start = $created->clone->truncate( to => 'week' );
+ my $check_week_start = $check->clone->truncate( to => 'week' );
- return 0 unless $check_week_start >= $created_week_start;
-
- if ( $check_week_start == $created_week_start ) {
- if ( $check->day_of_week > $created->day_of_week ) {
- return 1;
- }
- else {
- return 0;
- }
- }
+ return 0 unless $check_week_start > $created_week_start;
return 1 if $span == 1;
@@ -691,8 +690,8 @@ sub CheckLastTicket {
}
}
elsif ( $type eq 'month' ) {
- my $created_month_start = $created->clone->set( day => 1 );
- my $check_month_start = $check->clone->set( day => 1 );
+ my $created_month_start = $created->clone->truncate( to => 'month' );
+ my $check_month_start = $check->clone->truncate( to => 'month' );
return 0 unless $check_month_start > $created_month_start;
return 1 if $span == 1;
@@ -713,12 +712,6 @@ sub CheckLastTicket {
}
}
- if ( $check->ymd ge $created->ymd ) {
- return 1;
- }
- else {
- return 0;
- }
}
1;
commit 127ee0df8221a78f22cbdb36e0209d8a9165196e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 14:11:40 2012 +0800
back to subtract as truncate to "week" returns Monday instead of Sunday; also refactor a bit
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 5838615..d3a0c23 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -197,7 +197,7 @@ sub Repeat {
}
@$weeks = sort @$weeks;
- $due_date->truncate( to => 'week' );
+ $due_date->subtract( days => $due_date->day_of_week );
my ($after) = after { $_ == $date->day_of_week } @$weeks;
if ($after) {
@@ -546,18 +546,15 @@ sub MaybeRepeatMore {
if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
$date->add( weeks => $span );
- $date->truncate( to => 'week' );
+ $date->subtract( days => $date->day_of_week );
while ( @dates < $total ) {
- if ( grep { $date->day_of_week == $_ } @$weeks ) {
- push @dates, $date->clone;
+ for my $day ( sort @$weeks ) {
+ push @dates, $date->clone->add( days => $day );
+ last if @dates == $total;
}
- $date->add( days => 1 );
-
- if ( $date->day_of_week == 0 ) {
- $date->add( weeks => $span );
- }
+ $date->add( weeks => $span );
}
}
}
@@ -673,8 +670,10 @@ sub CheckLastTicket {
}
}
elsif ( $type eq 'week' ) {
- my $created_week_start = $created->clone->truncate( to => 'week' );
- my $check_week_start = $check->clone->truncate( to => 'week' );
+ my $created_week_start =
+ $created->clone->subtract( days => $created->day_of_week );
+ my $check_week_start =
+ $check->clone->subtract( days => $check->day_of_week );
return 0 unless $check_week_start > $created_week_start;
commit b9975b861001666f93746583eedf7d4a765b652a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 14:28:32 2012 +0800
day_of_week return 1..7 instead of 0..6
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index d3a0c23..e42d91f 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -191,15 +191,15 @@ sub Repeat {
}
$weeks = [$weeks] unless ref $weeks;
- unless ( grep { $_ == $checkday->day_of_week } @$weeks ) {
+ unless ( grep { $_ == $checkday->day_of_week % 7 } @$weeks ) {
$RT::Logger->debug('Failed weeks check');
next;
}
@$weeks = sort @$weeks;
- $due_date->subtract( days => $due_date->day_of_week );
+ $due_date->subtract( days => $due_date->day_of_week % 7 );
- my ($after) = after { $_ == $date->day_of_week } @$weeks;
+ my ($after) = after { $_ == $date->day_of_week % 7 } @$weeks;
if ($after) {
$due_date->add( days => $after );
}
@@ -248,7 +248,7 @@ sub Repeat {
}
elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
my $day = $content->{'repeat-details-monthly-week-week'} || 0;
- unless ( $day == $checkday->day_of_week ) {
+ unless ( $day == $checkday->day_of_week % 7 ) {
$RT::Logger->debug('Failed day of week check');
next;
}
@@ -273,11 +273,12 @@ sub Repeat {
$due_date->add( months => $span );
$due_date->truncate( to => 'month' );
$due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week ) {
- $due_date->add( days => $day - $due_date->day_of_week );
+ if ( $day > $due_date->day_of_week % 7 ) {
+ $due_date->add( days => $day - $due_date->day_of_week % 7 );
}
- elsif ( $day < $due_date->day_of_week ) {
- $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ elsif ( $day < $due_date->day_of_week % 7 ) {
+ $due_date->add(
+ days => 7 + $day - $due_date->day_of_week % 7 );
}
}
elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
@@ -318,7 +319,7 @@ sub Repeat {
}
elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
my $day = $content->{'repeat-details-yearly-week-week'} || 0;
- unless ( $day == $checkday->day_of_week ) {
+ unless ( $day == $checkday->day_of_week % 7 ) {
$RT::Logger->debug('Failed day of week check');
next;
}
@@ -340,11 +341,12 @@ sub Repeat {
$due_date->add( year => 1 );
$due_date->truncate( to => 'month' );
$due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week ) {
- $due_date->add( days => $day - $due_date->day_of_week );
+ if ( $day > $due_date->day_of_week % 7 ) {
+ $due_date->add( days => $day - $due_date->day_of_week % 7 );
}
- elsif ( $day < $due_date->day_of_week ) {
- $due_date->add( days => 7 + $day - $due_date->day_of_week );
+ elsif ( $day < $due_date->day_of_week % 7 ) {
+ $due_date->add(
+ days => 7 + $day - $due_date->day_of_week % 7 );
}
}
elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
@@ -546,7 +548,7 @@ sub MaybeRepeatMore {
if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
$date->add( weeks => $span );
- $date->subtract( days => $date->day_of_week );
+ $date->subtract( days => $date->day_of_week % 7 );
while ( @dates < $total ) {
for my $day ( sort @$weeks ) {
@@ -582,11 +584,11 @@ sub MaybeRepeatMore {
$date->truncate( to => 'month' );
$date->add( weeks => $number - 1 );
- if ( $day > $date->day_of_week ) {
- $date->add( days => $day - $date->day_of_week );
+ if ( $day > $date->day_of_week % 7 ) {
+ $date->add( days => $day - $date->day_of_week % 7 );
}
- elsif ( $day < $date->day_of_week ) {
- $date->add( days => 7 + $day - $date->day_of_week );
+ elsif ( $day < $date->day_of_week % 7 ) {
+ $date->add( days => 7 + $day - $date->day_of_week % 7 );
}
push @dates, $date->clone;
}
@@ -617,11 +619,11 @@ sub MaybeRepeatMore {
$date->add( years => 1 );
$date->truncate( to => 'month' );
$date->add( weeks => $number - 1 );
- if ( $day > $date->day_of_week ) {
- $date->add( days => $day - $date->day_of_week );
+ if ( $day > $date->day_of_week % 7 ) {
+ $date->add( days => $day - $date->day_of_week % 7 );
}
- elsif ( $day < $date->day_of_week ) {
- $date->add( days => 7 + $day - $date->day_of_week );
+ elsif ( $day < $date->day_of_week % 7 ) {
+ $date->add( days => 7 + $day - $date->day_of_week % 7 );
}
push @dates, $date->clone;
}
@@ -671,9 +673,9 @@ sub CheckLastTicket {
}
elsif ( $type eq 'week' ) {
my $created_week_start =
- $created->clone->subtract( days => $created->day_of_week );
+ $created->clone->subtract( days => $created->day_of_week % 7 );
my $check_week_start =
- $check->clone->subtract( days => $check->day_of_week );
+ $check->clone->subtract( days => $check->day_of_week % 7 );
return 0 unless $check_week_start > $created_week_start;
commit e1c0f35bec9596d04f2f199281afcf252224395a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 14:35:50 2012 +0800
default is sunday
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index e42d91f..a3d8fe1 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -577,7 +577,7 @@ sub MaybeRepeatMore {
my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $number = $content->{'repeat-details-monthly-week-number'}
|| 1;
- my $day = $content->{'repeat-details-monthly-week-day'} || 1;
+ my $day = $content->{'repeat-details-monthly-week-week'} || 0;
for ( 1 .. $total ) {
$date->add( months => $span );
@@ -613,7 +613,7 @@ sub MaybeRepeatMore {
my $number = $content->{'repeat-details-yearly-week-number'}
|| 1;
- my $day = $content->{'repeat-details-yearly-week-day'} || 1;
+ my $day = $content->{'repeat-details-yearly-week-week'} || 0;
for ( 1 .. $total ) {
$date->add( years => 1 );
commit ab1b05c0409abfe6946c063b1cf84b56c1c3baee
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 14:37:28 2012 +0800
typo fix
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index a3d8fe1..a55f1e9 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -338,7 +338,7 @@ sub Repeat {
next;
}
- $due_date->add( year => 1 );
+ $due_date->add( years => 1 );
$due_date->truncate( to => 'month' );
$due_date->add( weeks => $number - 1 );
if ( $day > $due_date->day_of_week % 7 ) {
commit 0d1e3acd7a79369d6ad76bbe4ca1325260645cd2
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 8 14:46:30 2012 +0800
logic fix
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index a55f1e9..af16b6f 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -97,10 +97,10 @@ sub Repeat {
if ( $content->{'repeat-end'} && $content->{'repeat-end'} eq 'number' )
{
- if ( $content->{'repeat-end-number'} >=
+ if ( $content->{'repeat-end-number'} <=
$content->{'repeat-occurrences'} )
{
- $RT::Logger->debug( 'Failed repeat-end-number check' );
+ $RT::Logger->debug('Failed repeat-end-number check');
last;
}
}
commit e90110f8a9a37466d228fec2996da163d7fa6fdc
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jun 9 19:03:00 2012 +0800
Last week number support
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index f1697db..32a98a2 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -131,7 +131,7 @@ $number %>"
<td>
<input name="repeat-details-monthly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
<select name="repeat-details-monthly-week-number">
-% for my $number ( 1 .. 4 ) {
+% for my $number ( 1 .. 5 ) {
<option value="<% $number %>" <%($ARGSRef->{'repeat-details-monthly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
% }
</select>
@@ -171,7 +171,7 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
<td>
<input name="repeat-details-yearly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
<select name="repeat-details-yearly-week-number">
-% for my $number ( 1 .. 4 ) {
+% for my $number ( 1 .. 5 ) {
<option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
% }
</select>
@@ -242,7 +242,7 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
<%init>
my @week_labels = qw/Sunday Monday Tuesday Wedsenday Thursday Friday Saturday/; # loc
-my @week_number_labels = qw/First Second Third Fourth/; # loc
+my @week_number_labels = qw/First Second Third Fourth Last/; # loc
my @month_labels = qw/January February March April May June July August September October November December/; # loc
if ( $Ticket ) {
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index af16b6f..3e5ac8f 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -256,9 +256,7 @@ sub Repeat {
my $number = $content->{'repeat-details-monthly-week-number'}
|| 1;
- unless (
- $number == int( ( $checkday->day_of_month - 1 ) / 7 ) + 1 )
- {
+ unless ( CheckWeekNumber( $checkday, $number ) ) {
$RT::Logger->debug('Failed week number check');
next;
}
@@ -332,8 +330,7 @@ sub Repeat {
my $number = $content->{'repeat-details-yearly-week-number'}
|| 1;
- unless ( $number ==
- int( ( $checkday->day_of_month - 1 ) / 7 ) + 1 ) {
+ unless ( CheckWeekNumber( $checkday, $number ) ) {
$RT::Logger->debug('Failed week number check');
next;
}
@@ -715,6 +712,29 @@ sub CheckLastTicket {
}
+sub CheckWeekNumber {
+ my $date = shift;
+ my $number = shift || 1;
+ if ( $number == 5 ) { # last one, not just 5th
+ my $next_month =
+ $date->clone->truncate( to => 'month' )->add( months => 1 );
+ if ( $next_month->epoch - $date->epoch <= 24 * 3600 * 7 ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+ }
+ else {
+ if ( $number == int( ( $date->day_of_month - 1 ) / 7 ) + 1 ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+ }
+}
+
1;
__END__
commit 77789864dabc13b66e3366b8ce78a2e27079e56b
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jun 9 20:17:25 2012 +0800
--date argument
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
index 46600fb..adcb7a4 100755
--- a/bin/rt-repeat-ticket
+++ b/bin/rt-repeat-ticket
@@ -7,7 +7,7 @@ use lib '/opt/rt4/lib';
use Getopt::Long;
my %opt;
-GetOptions( \%opt, 'help|h', );
+GetOptions( \%opt, 'help|h', 'date=s' );
if ( $opt{help} ) {
require Pod::Usage;
@@ -20,16 +20,37 @@ RT::LoadConfig();
RT::Init();
use RT::Attributes;
+use RT::Date;
my $attrs = RT::Attributes->new( RT->SystemUser );
$attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
use RT::Extension::RepeatTicket;
-my $today = DateTime->today( time_zone => RT->Config->Get('Timezone') );
+my $date;
+if ( $opt{date} ) {
+ my $d = RT::Date->new( RT->SystemUser );
+ $d->Set(
+ Format => 'unknown',
+ Value => $opt{date},
+ );
+
+ # can't use ->Unix because timezone issue
+ # where $d->Unix could return a small seconds after 1970-01-01 00:00:00 UTC
+ # if date parse fails
+ if ( $d->Date ne '1970-01-01' ) {
+ $date = DateTime->from_epoch(
+ epoch => $d->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ }
+}
+
+$date ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
+
while ( my $attr = $attrs->Next ) {
next unless $attr->Content->{'repeat-enabled'};
$RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
- my @ids = RT::Extension::RepeatTicket::Run( $attr, $today );
+ my @ids = RT::Extension::RepeatTicket::Run( $attr, $date );
if ( @ids ) {
$RT::Logger->info(
'Repeated ticket ' . $attr->Object->id . ': ' . join ', ', @ids );
commit 5b722a0fd50216b89bf452c53b85cb30ab4b7bf5
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jun 9 20:18:01 2012 +0800
methods doc
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 3e5ac8f..9c9c9e0 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -763,6 +763,27 @@ C<$RepeatTicketCoexistentNumber> only works for repeats that don't rely on the
completion of previous tickets, in which case the config will be simply
ignored.
+=head1 Methods
+
+=head2 Run( RT::Attribute $attr, DateTime $checkday )
+
+Repeat the ticket if C<$checkday> meets the repeat settings.
+It also tries to repeat more to meet config C<RepeatTicketCoexistentNumber>.
+
+returns ids of new created tickets.
+
+=head2 Repeat ( RT::Attribute $attr, DateTime $checkday_1, DateTime $checkday_2, ... )
+
+Repeat the ticket for the check days that meet repeat settings.
+
+returns ids of new created tickets.
+
+=head2 MaybeRepeatMore ( RT::Attribute $attr )
+
+Try to repeat more tickets to meet the coexistent ticket number.
+
+Returns ids of new created tickets.
+
=head1 AUTHOR
sunnavy, <sunnavy at bestpractical.com>
commit 0f1c13c4ed6d373be3e6e79e60e2701bb92063e1
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jun 9 20:23:33 2012 +0800
cleanup: the new approach does not need to adjuest $due
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 9c9c9e0..fb4a31c 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -642,7 +642,6 @@ sub CheckLastTicket {
if ( $last_ticket->DueObj->Unix ) {
my $due = $last_ticket->DueObj;
- $due->AddDays(-1);
if ( $date->ymd ge $due->Date( Timezone => 'user' ) ) {
return 1;
}
commit 929a010659be1ced622bb2cae7d64994b33f436a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Jun 9 20:32:53 2012 +0800
tweak doc
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index fb4a31c..7af7881 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -755,13 +755,15 @@ To install this module, run the following commands:
add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
- Set( $RepeatTicketCoexistentNumber, 1 );
Set( @Plugins, qw(... RT::Extension::RepeatTicket) );
+ Set( $RepeatTicketCoexistentNumber, 1 );
C<$RepeatTicketCoexistentNumber> only works for repeats that don't rely on the
completion of previous tickets, in which case the config will be simply
ignored.
+add bin/rt-repeat-ticket to the daily cron job.
+
=head1 Methods
=head2 Run( RT::Attribute $attr, DateTime $checkday )
@@ -769,19 +771,25 @@ ignored.
Repeat the ticket if C<$checkday> meets the repeat settings.
It also tries to repeat more to meet config C<RepeatTicketCoexistentNumber>.
-returns ids of new created tickets.
+Return ids of new created tickets.
=head2 Repeat ( RT::Attribute $attr, DateTime $checkday_1, DateTime $checkday_2, ... )
Repeat the ticket for the check days that meet repeat settings.
-returns ids of new created tickets.
+Return ids of new created tickets.
=head2 MaybeRepeatMore ( RT::Attribute $attr )
Try to repeat more tickets to meet the coexistent ticket number.
-Returns ids of new created tickets.
+Return ids of new created tickets.
+
+=head2 SetRepeatAttribute ( RT::Ticket $ticket, %args )
+
+Save %args to the ticket's "RepeatTicketSettings" attribute.
+
+Return ( RT::Attribute, UPDATE MESSAGE )
=head1 AUTHOR
commit ffb639996d64d9680c0fe204fc212758b2095dc0
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Jun 10 10:34:40 2012 +0800
abstract CheckComplete code
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 7af7881..773ee8b 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -151,22 +151,18 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
- unless (
- $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status
- )
- )
- {
+ unless ( CheckCompleteStatus( $last_ticket ) ) {
$RT::Logger->debug('Failed complete status check');
last;
}
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- days => $content->{'repeat-details-daily-complete'} || 1 );
-
- if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
+ unless (
+ CheckCompleteDate(
+ $checkday, $last_ticket, 'day',
+ $content->{'repeat-details-daily-complete'}
+ )
+ )
+ {
$RT::Logger->debug('Failed complete date check');
next;
}
@@ -209,21 +205,18 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
+ unless ( CheckCompleteStatus( $last_ticket ) ) {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
+
unless (
- $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status
+ CheckCompleteDate(
+ $checkday, $last_ticket, 'week',
+ $content->{'repeat-details-weekly-complete'}
)
)
{
- $RT::Logger->debug('Failed complete status check');
- last;
- }
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- weeks => $content->{'repeat-details-weekly-complete'}
- || 1 );
- if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
$RT::Logger->debug('Failed complete date check');
next;
}
@@ -280,21 +273,18 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
+ unless ( CheckCompleteStatus( $last_ticket ) ) {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
+
unless (
- $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status
+ CheckCompleteDate(
+ $checkday, $last_ticket, 'month',
+ $content->{'repeat-details-monthly-complete'}
)
)
{
- $RT::Logger->debug('Failed complete status check');
- last;
- }
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- months => $content->{'repeat-details-monthly-complete'}
- || 1 );
- if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
$RT::Logger->debug('Failed complete date check');
next;
}
@@ -347,21 +337,18 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
+ unless ( CheckCompleteStatus( $last_ticket ) ) {
+ $RT::Logger->debug('Failed complete status check');
+ last;
+ }
+
unless (
- $last_ticket->QueueObj->Lifecycle->IsInactive(
- $last_ticket->Status
+ CheckCompleteDate(
+ $checkday, $last_ticket, 'year',
+ $content->{'repeat-details-yearly-complete'}
)
)
{
- $RT::Logger->debug('Failed complete status check');
- last;
- }
- my $resolved = $last_ticket->ResolvedObj;
- my $date = $checkday->clone;
- $date->subtract(
- years => $content->{'repeat-details-yearly-complete'}
- || 1 );
- if ( $resolved->Date( Timezone => 'user' ) gt $date->ymd ) {
$RT::Logger->debug('Failed complete date check');
next;
}
@@ -734,6 +721,31 @@ sub CheckWeekNumber {
}
}
+sub CheckCompleteStatus {
+ my $ticket = shift;
+ return 1 if $ticket->QueueObj->Lifecycle->IsInactive( $ticket->Status );
+ return 0;
+}
+
+sub CheckCompleteDate {
+ my $checkday = shift;
+ my $ticket = shift;
+ my $type = shift || 'day';
+ my $span = shift;
+ $span = 1 unless defined $span;
+
+ my $resolved = $ticket->ResolvedObj;
+ my $date = $checkday->clone;
+ if ($span) {
+ $date->subtract( "${type}s" => $span );
+ }
+
+ return 0
+ if $resolved->Date( Timezone => 'user' ) gt $date->ymd;
+
+ return 1;
+}
+
1;
__END__
commit f919a2b75596e08f216c48ed607ed130f875e336
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Jun 10 11:05:40 2012 +0800
perltidy
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 773ee8b..41dbf7c 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -20,11 +20,11 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
if ( $ticket && $args{'repeat-enabled'} ) {
my ($attr) = SetRepeatAttribute(
$ticket,
- 'tickets' => [ $ticket->id ],
+ 'tickets' => [ $ticket->id ],
'last-ticket' => $ticket->id,
map { $_ => $args{$_} } grep { /^repeat/ } keys %args
);
- MaybeRepeatMore( $attr );
+ MaybeRepeatMore($attr);
}
return ( $ticket, @actions );
};
@@ -33,16 +33,16 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
sub SetRepeatAttribute {
my $ticket = shift;
return 0 unless $ticket;
- my %args = @_;
+ my %args = @_;
my %repeat_args = (
'repeat-enabled' => undef,
'repeat-details-weekly-weeks' => undef,
- %args
+ %args
);
- my ( $old_attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
+ my ($old_attr) = $ticket->Attributes->Named('RepeatTicketSettings');
my %old;
- %old = %{$old_attr->Content} if $old_attr;
+ %old = %{ $old_attr->Content } if $old_attr;
my $content = { %old, %repeat_args };
@@ -51,7 +51,7 @@ sub SetRepeatAttribute {
Content => $content,
);
- my ( $attr ) = $ticket->Attributes->Named('RepeatTicketSettings');
+ my ($attr) = $ticket->Attributes->Named('RepeatTicketSettings');
return ( $attr, $ticket->loc('Recurrence updated') ); # loc
}
@@ -59,19 +59,20 @@ sub SetRepeatAttribute {
use RT::Ticket;
sub Run {
- my $attr = shift;
+ my $attr = shift;
my $content = $attr->Content;
return unless $content->{'repeat-enabled'};
my $checkday = shift
|| DateTime->today( time_zone => RT->Config->Get('Timezone') );
my @ids = Repeat( $attr, $checkday );
- push @ids, MaybeRepeatMore( $attr ); # create more to meet the coexistent number
+ push @ids,
+ MaybeRepeatMore($attr); # create more to meet the coexistent number
return @ids;
}
sub Repeat {
- my $attr = shift;
+ my $attr = shift;
my @checkdays = @_;
my @ids;
@@ -90,7 +91,7 @@ sub Repeat {
Value => $content->{'repeat-start-date'},
);
if ( $checkday->ymd lt $date->Date ) {
- $RT::Logger->debug( 'Failed repeat-start-date check' );
+ $RT::Logger->debug('Failed repeat-start-date check');
next;
}
}
@@ -113,7 +114,7 @@ sub Repeat {
);
if ( $checkday->ymd gt $date->Date ) {
- $RT::Logger->debug( 'Failed repeat-end-date check' );
+ $RT::Logger->debug('Failed repeat-end-date check');
next;
}
}
@@ -128,7 +129,8 @@ sub Repeat {
my $span = $content->{'repeat-details-daily-day'} || 1;
my $date = $checkday->clone;
- unless ( CheckLastTicket( $date, $last_ticket, 'day', $span ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'day', $span ) )
+ {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -151,7 +153,7 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
- unless ( CheckCompleteStatus( $last_ticket ) ) {
+ unless ( CheckCompleteStatus($last_ticket) ) {
$RT::Logger->debug('Failed complete status check');
last;
}
@@ -174,7 +176,8 @@ sub Repeat {
my $span = $content->{'repeat-details-weekly-week'} || 1;
my $date = $checkday->clone;
- unless ( CheckLastTicket( $date, $last_ticket, 'week', $span ) ) {
+ unless ( CheckLastTicket( $date, $last_ticket, 'week', $span ) )
+ {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -205,7 +208,7 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
- unless ( CheckCompleteStatus( $last_ticket ) ) {
+ unless ( CheckCompleteStatus($last_ticket) ) {
$RT::Logger->debug('Failed complete status check');
last;
}
@@ -232,7 +235,9 @@ sub Repeat {
my $span = $content->{'repeat-details-monthly-day-month'} || 1;
my $date = $checkday->clone;
- unless ( CheckLastTicket( $date, $last_ticket, 'month', $span ) ) {
+ unless (
+ CheckLastTicket( $date, $last_ticket, 'month', $span ) )
+ {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -256,7 +261,9 @@ sub Repeat {
my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $date = $checkday->clone;
- unless ( CheckLastTicket( $date, $last_ticket, 'month', $span ) ) {
+ unless (
+ CheckLastTicket( $date, $last_ticket, 'month', $span ) )
+ {
$RT::Logger->debug('Failed last-ticket date check');
next;
}
@@ -273,7 +280,7 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
- unless ( CheckCompleteStatus( $last_ticket ) ) {
+ unless ( CheckCompleteStatus($last_ticket) ) {
$RT::Logger->debug('Failed complete status check');
last;
}
@@ -337,7 +344,7 @@ sub Repeat {
}
}
elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
- unless ( CheckCompleteStatus( $last_ticket ) ) {
+ unless ( CheckCompleteStatus($last_ticket) ) {
$RT::Logger->debug('Failed complete status check');
last;
}
@@ -394,7 +401,7 @@ sub _RepeatTicket {
my $repeat_ticket = shift;
return unless $repeat_ticket;
- my %args = @_;
+ my %args = @_;
my $repeat = {
Queue => $repeat_ticket->Queue,
Requestor => join( ',', $repeat_ticket->RequestorAddresses ),
@@ -457,8 +464,8 @@ sub _RepeatTicket {
$txns->Limit( FIELD => 'Type', VALUE => 'Create' );
$txns->OrderBy( FIELD => 'id', ORDER => 'ASC' );
$txns->RowsPerPage(1);
- my $txn = $txns->First;
- my $atts = RT::Attachments->new(RT->SystemUser);
+ my $txn = $txns->First;
+ my $atts = RT::Attachments->new( RT->SystemUser );
$atts->OrderBy( FIELD => 'id', ORDER => 'ASC' );
$atts->Limit( FIELD => 'TransactionId', VALUE => $txn->id );
$atts->Limit( FIELD => 'Parent', VALUE => 0 );
@@ -477,7 +484,7 @@ sub _RepeatTicket {
}
sub MaybeRepeatMore {
- my $attr = shift;
+ my $attr = shift;
my $content = $attr->Content;
my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
@@ -501,7 +508,7 @@ sub MaybeRepeatMore {
} @$tickets;
$content->{tickets} = $tickets;
- $attr->SetContent( $content );
+ $attr->SetContent($content);
my @ids;
if ( $co_number > @$tickets ) {
@@ -527,7 +534,7 @@ sub MaybeRepeatMore {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
my $span = $content->{'repeat-details-weekly-week'} || 1;
my $weeks = $content->{'repeat-details-weekly-weeks'};
- if (defined $weeks ) {
+ if ( defined $weeks ) {
$weeks = [$weeks] unless ref $weeks;
if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
@@ -604,10 +611,10 @@ sub MaybeRepeatMore {
$date->truncate( to => 'month' );
$date->add( weeks => $number - 1 );
if ( $day > $date->day_of_week % 7 ) {
- $date->add( days => $day - $date->day_of_week % 7 );
+ $date->add( days => $day - $date->day_of_week % 7 );
}
- elsif ( $day < $date->day_of_week % 7 ) {
- $date->add( days => 7 + $day - $date->day_of_week % 7 );
+ elsif ( $day < $date->day_of_week % 7 ) {
+ $date->add( days => 7 + $day - $date->day_of_week % 7 );
}
push @dates, $date->clone;
}
@@ -622,10 +629,10 @@ sub MaybeRepeatMore {
}
sub CheckLastTicket {
- my $date = shift;
+ my $date = shift;
my $last_ticket = shift;
- my $type = shift;
- my $span = shift || 1;
+ my $type = shift;
+ my $span = shift || 1;
if ( $last_ticket->DueObj->Unix ) {
my $due = $last_ticket->DueObj;
commit 43c1fcc0d2756574a2a149f97c9fa906ef5de5f6
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sun Jun 10 11:07:04 2012 +0800
update abstract
diff --git a/META.yml b/META.yml
index ed352aa..ecedb4a 100644
--- a/META.yml
+++ b/META.yml
@@ -1,5 +1,5 @@
---
-abstract: 'The great new RT::Extension::RepeatTicket!'
+abstract: 'Repeat tickets based on schedule'
author:
- 'sunnavy, <sunnavy at bestpractical.com>'
build_requires:
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 41dbf7c..992185a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -758,7 +758,7 @@ __END__
=head1 NAME
-RT::Extension::RepeatTicket - The great new RT::Extension::RepeatTicket!
+RT::Extension::RepeatTicket - Repeat tickets based on schedule
=head1 VERSION
commit 89093a4ae778bc33d2d8e02e200c4f7e12deb8bb
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Jun 26 22:29:19 2012 +0800
import m:i:rtx
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
new file mode 100644
index 0000000..23ce911
--- /dev/null
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -0,0 +1,483 @@
+#line 1
+package Module::Install::RTx::Factory;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use strict;
+use File::Basename ();
+
+sub RTxInitDB {
+ my ($self, $action) = @_;
+
+ unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+
+ require RT;
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+
+ $RT::SbinPath ||= $RT::LocalPath;
+ $RT::SbinPath =~ s/local$/sbin/;
+
+ foreach my $file ($RT::CORE_CONFIG_FILE, $RT::SITE_CONFIG_FILE) {
+ next if !-e $file or -r $file;
+ die "No permission to read $file\n-- please re-run $0 with suitable privileges.\n";
+ }
+
+ RT::LoadConfig();
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ my @args = ("-Ilib");
+ push @args, "-I$RT::LocalPath/lib" if $RT::LocalPath;
+ push @args, (
+ "-I$lib_path",
+ "$RT::SbinPath/rt-setup-database",
+ "--action" => $action,
+ "--datadir" => "etc",
+ (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
+ "--dba" => $RT::DatabaseUser,
+ "--prompt-for-dba-password" => ''
+ );
+ print "$^X @args\n";
+ (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+sub RTxFactory {
+ my ($self, $RTx, $name, $drop) = @_;
+ my $namespace = "$RTx\::$name";
+
+ $self->RTxInit;
+
+ my $dbh = $RT::Handle->dbh;
+ # get all tables out of database
+ my @tables = $dbh->tables;
+ my ( %tablemap, %typemap, %modulemap );
+ my $driver = $RT::DatabaseType;
+
+ my $CollectionBaseclass = 'RT::SearchBuilder';
+ my $RecordBaseclass = 'RT::Record';
+ my $LicenseBlock = << '.';
+# BEGIN LICENSE BLOCK
+#
+# END LICENSE BLOCK
+.
+ my $Attribution = << '.';
+# Autogenerated by Module::Intall::RTx::Factory
+# WARNING: THIS FILE IS AUTOGENERATED. ALL CHANGES TO THIS FILE WILL BE LOST.
+#
+# !! DO NOT EDIT THIS FILE !!
+#
+
+use strict;
+.
+ my $RecordInit = '';
+
+ @tables = map { do { {
+ my $table = $_;
+ $table =~ s/.*\.//g;
+ $table =~ s/\W//g;
+ $table =~ s/^\Q$name\E_//i or next;
+ $table ne 'sessions' or next;
+
+ $table = ucfirst(lc($table));
+ $table =~ s/$_/\u$_/ for qw(field group custom member value);
+ $table =~ s/(?<=Scrip)$_/\u$_/ for qw(action condition);
+ $table =~ s/$_/\U$_/ for qw(Acl);
+ $table = $name . '_' . $table;
+
+ $tablemap{$table} = $table;
+ $modulemap{$table} = $table;
+ if ( $table =~ /^(.*)s$/ ) {
+ $tablemap{$1} = $table;
+ $modulemap{$1} = $1;
+ }
+ $table;
+ } } } @tables;
+
+ $tablemap{'CreatedBy'} = 'User';
+ $tablemap{'UpdatedBy'} = 'User';
+
+ $typemap{'id'} = 'ro';
+ $typemap{'Creator'} = 'auto';
+ $typemap{'Created'} = 'auto';
+ $typemap{'Updated'} = 'auto';
+ $typemap{'UpdatedBy'} = 'auto';
+ $typemap{'LastUpdated'} = 'auto';
+ $typemap{'LastUpdatedBy'} = 'auto';
+
+ $typemap{lc($_)} = $typemap{$_} for keys %typemap;
+
+ foreach my $table (@tables) {
+ if ($drop) {
+ $dbh->do("DROP TABLE $table");
+ $dbh->do("DROP sequence ${table}_id_seq") if $driver eq 'Pg';
+ $dbh->do("DROP sequence ${table}_seq") if $driver eq 'Oracle';
+ next;
+ }
+
+ my $tablesingle = $table;
+ $tablesingle =~ s/^\Q$name\E_//i;
+ $tablesingle =~ s/s$//;
+ my $tableplural = $tablesingle . "s";
+
+ if ( $tablesingle eq 'ACL' ) {
+ $tablesingle = "ACE";
+ $tableplural = "ACL";
+ }
+
+ my %requirements;
+
+ my $CollectionClassName = $namespace . "::" . $tableplural;
+ my $RecordClassName = $namespace . "::" . $tablesingle;
+
+ my $path = $namespace;
+ $path =~ s/::/\//g;
+
+ my $RecordClassPath = $path . "/" . $tablesingle . ".pm";
+ my $CollectionClassPath = $path . "/" . $tableplural . ".pm";
+
+ #create a collection class
+ my $CreateInParams;
+ my $CreateOutParams;
+ my $ClassAccessible = "";
+ my $FieldsPod = "";
+ my $CreatePod = "";
+ my $CreateSub = "";
+ my %fields;
+ my $sth = $dbh->prepare("DESCRIBE $table");
+
+ if ( $driver eq 'Pg' ) {
+ $sth = $dbh->prepare(<<".");
+ SELECT a.attname, format_type(a.atttypid, a.atttypmod),
+ a.attnotnull, a.atthasdef, a.attnum
+ FROM pg_class c, pg_attribute a
+ WHERE c.relname ILIKE '$table'
+ AND a.attnum > 0
+ AND a.attrelid = c.oid
+ORDER BY a.attnum
+.
+ }
+ elsif ( $driver eq 'mysql' ) {
+ $sth = $dbh->prepare("DESCRIBE $table");
+ }
+ else {
+ die "$driver is currently unsupported";
+ }
+
+ $sth->execute;
+
+ while ( my $row = $sth->fetchrow_hashref() ) {
+ my ( $field, $type, $default );
+ if ( $driver eq 'Pg' ) {
+
+ $field = $row->{'attname'};
+ $type = $row->{'format_type'};
+ $default = $row->{'atthasdef'};
+
+ if ( $default != 0 ) {
+ my $tth = $dbh->prepare(<<".");
+SELECT substring(d.adsrc for 128)
+ FROM pg_attrdef d, pg_class c
+ WHERE c.relname = 'acct'
+ AND c.oid = d.adrelid
+ AND d.adnum = $row->{'attnum'}
+.
+ $tth->execute();
+ my @default = $tth->fetchrow_array;
+ $default = $default[0];
+ }
+
+ }
+ elsif ( $driver eq 'mysql' ) {
+ $field = $row->{'Field'};
+ $type = $row->{'Type'};
+ $default = $row->{'Default'};
+ }
+
+ $fields{$field} = 1;
+
+ #generate the 'accessible' datastructure
+
+ if ( $typemap{$field} eq 'auto' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1, auto => 1,";
+ }
+ elsif ( $typemap{$field} eq 'ro' ) {
+ $ClassAccessible .= " $field =>
+ {read => 1,";
+ }
+ else {
+ $ClassAccessible .= " $field =>
+ {read => 1, write => 1,";
+
+ }
+
+ $ClassAccessible .= " type => '$type', default => '$default'},\n";
+
+ #generate pod for the accessible fields
+ $FieldsPod .= $self->_pod(<<".");
+^head2 $field
+
+Returns the current value of $field.
+(In the database, $field is stored as $type.)
+
+.
+
+ unless ( $typemap{$field} eq 'auto' || $typemap{$field} eq 'ro' ) {
+ $FieldsPod .= $self->_pod(<<".");
+
+^head2 Set$field VALUE
+
+
+Set $field to VALUE.
+Returns (1, 'Status message') on success and (0, 'Error Message') on failure.
+(In the database, $field will be stored as a $type.)
+
+.
+ }
+
+ $FieldsPod .= $self->_pod(<<".");
+^cut
+
+.
+
+ if ( $modulemap{$field} ) {
+ $FieldsPod .= $self->_pod(<<".");
+^head2 ${field}Obj
+
+Returns the $modulemap{$field} Object which has the id returned by $field
+
+
+^cut
+
+sub ${field}Obj {
+ my \$self = shift;
+ my \$$field = ${namespace}::$modulemap{$field}->new(\$self->CurrentUser);
+ \$$field->Load(\$self->__Value('$field'));
+ return(\$$field);
+}
+.
+ $requirements{ $tablemap{$field} } =
+ "use ${namespace}::$modulemap{$field};";
+
+ }
+
+ unless ( $typemap{$field} eq 'auto' || $field eq 'id' ) {
+
+ #generate create statement
+ $CreateInParams .= " $field => '$default',\n";
+ $CreateOutParams .=
+ " $field => \$args{'$field'},\n";
+
+ #gerenate pod for the create statement
+ $CreatePod .= " $type '$field'";
+ $CreatePod .= " defaults to '$default'" if ($default);
+ $CreatePod .= ".\n";
+
+ }
+
+ }
+
+ $CreateSub = <<".";
+sub Create {
+ my \$self = shift;
+ my \%args = (
+$CreateInParams
+ \@_);
+ \$self->SUPER::Create(
+$CreateOutParams);
+
+}
+.
+ $CreatePod .= "\n=cut\n\n";
+
+ my $CollectionClass = $LicenseBlock . $Attribution . $self->_pod(<<".") . $self->_magic_import($CollectionClassName);
+
+^head1 NAME
+
+$CollectionClassName -- Class Description
+
+^head1 SYNOPSIS
+
+use $CollectionClassName
+
+^head1 DESCRIPTION
+
+
+^head1 METHODS
+
+^cut
+
+package $CollectionClassName;
+
+use $CollectionBaseclass;
+use $RecordClassName;
+
+use vars qw( \@ISA );
+\@ISA= qw($CollectionBaseclass);
+
+
+sub _Init {
+ my \$self = shift;
+ \$self->{'table'} = '$table';
+ \$self->{'primary_key'} = 'id';
+
+.
+
+ if ( $fields{'SortOrder'} ) {
+
+ $CollectionClass .= $self->_pod(<<".");
+
+# By default, order by name
+\$self->OrderBy( ALIAS => 'main',
+ FIELD => 'SortOrder',
+ ORDER => 'ASC');
+.
+ }
+ $CollectionClass .= $self->_pod(<<".");
+ return ( \$self->SUPER::_Init(\@_) );
+}
+
+
+^head2 NewItem
+
+Returns an empty new $RecordClassName item
+
+^cut
+
+sub NewItem {
+ my \$self = shift;
+ return($RecordClassName->new(\$self->CurrentUser));
+}
+.
+
+ my $RecordClassHeader = $Attribution . "
+
+^head1 NAME
+
+$RecordClassName
+
+
+^head1 SYNOPSIS
+
+^head1 DESCRIPTION
+
+^head1 METHODS
+
+^cut
+
+package $RecordClassName;
+use $RecordBaseclass;
+";
+
+ foreach my $key ( keys %requirements ) {
+ $RecordClassHeader .= $requirements{$key} . "\n";
+ }
+ $RecordClassHeader .= <<".";
+
+use vars qw( \@ISA );
+\@ISA= qw( $RecordBaseclass );
+
+sub _Init {
+my \$self = shift;
+
+\$self->Table('$table');
+\$self->SUPER::_Init(\@_);
+}
+
+.
+
+ my $RecordClass = $LicenseBlock . $RecordClassHeader . $self->_pod(<<".") . $self->_magic_import($RecordClassName);
+
+$RecordInit
+
+^head2 Create PARAMHASH
+
+Create takes a hash of values and creates a row in the database:
+
+$CreatePod
+
+$CreateSub
+
+$FieldsPod
+
+sub _CoreAccessible {
+ {
+
+$ClassAccessible
+}
+};
+
+.
+
+ print "About to make $RecordClassPath, $CollectionClassPath\n";
+ `mkdir -p $path`;
+
+ open( RECORD, ">$RecordClassPath" );
+ print RECORD $RecordClass;
+ close(RECORD);
+
+ open( COL, ">$CollectionClassPath" );
+ print COL $CollectionClass;
+ close(COL);
+
+ }
+}
+
+sub _magic_import {
+ my $self = shift;
+ my $class = ref($self) || $self;
+
+ #if (exists \$warnings::{unimport}) {
+ # no warnings qw(redefine);
+
+ my $path = $class;
+ $path =~ s#::#/#gi;
+
+
+ my $content = $self->_pod(<<".");
+ eval \"require ${class}_Overlay\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Overlay.pm}) {
+ die \$@;
+ };
+
+ eval \"require ${class}_Vendor\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Vendor.pm}) {
+ die \$@;
+ };
+
+ eval \"require ${class}_Local\";
+ if (\$@ && \$@ !~ qr{^Can't locate ${path}_Local.pm}) {
+ die \$@;
+ };
+
+
+
+
+^head1 SEE ALSO
+
+This class allows \"overlay\" methods to be placed
+into the following files _Overlay is for a System overlay by the original author,
+_Vendor is for 3rd-party vendor add-ons, while _Local is for site-local customizations.
+
+These overlay files can contain new subs or subs to replace existing subs in this module.
+
+If you'll be working with perl 5.6.0 or greater, each of these files should begin with the line
+
+ no warnings qw(redefine);
+
+so that perl does not kick and scream when you redefine a subroutine or variable in your overlay.
+
+${class}_Overlay, ${class}_Vendor, ${class}_Local
+
+^cut
+
+
+1;
+.
+
+ return $content;
+}
+
+sub _pod {
+ my ($self, $text) = @_;
+ $text =~ s/^\^/=/mg;
+ return $text;
+}
commit b437b96142bcabb38cb1d378cff66f4122f9df0c
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Jun 26 22:29:53 2012 +0800
use cf to link to original ticket that has the recurrence schedule
diff --git a/META.yml b/META.yml
index ecedb4a..664c8ef 100644
--- a/META.yml
+++ b/META.yml
@@ -16,6 +16,7 @@ meta-spec:
name: RT-Extension-RepeatTicket
no_index:
directory:
+ - etc
- html
- inc
resources:
diff --git a/etc/initialdata b/etc/initialdata
new file mode 100644
index 0000000..02a9351
--- /dev/null
+++ b/etc/initialdata
@@ -0,0 +1,9 @@
+ at CustomFields = (
+ {
+ Name => 'Original Ticket',
+ Type => 'FreeformSingle',
+ Queue => '0',
+ LinkValueTo => '/Ticket/Display.html?id=__CustomField__',
+ }
+);
+
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 992185a..ea8ac0c 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -402,12 +402,16 @@ sub _RepeatTicket {
return unless $repeat_ticket;
my %args = @_;
+ my $cf = RT::CustomField->new(RT->SystemUser);
+ $cf->Load('Original Ticket');
+
my $repeat = {
Queue => $repeat_ticket->Queue,
Requestor => join( ',', $repeat_ticket->RequestorAddresses ),
Cc => join( ',', $repeat_ticket->CcAddresses ),
AdminCc => join( ',', $repeat_ticket->AdminCcAddresses ),
InitialPriority => $repeat_ticket->Priority,
+ 'CustomField-' . $cf->id => $repeat_ticket->id,
};
$repeat->{$_} = $repeat_ticket->$_()
commit f89cf0776570a711fbb39f043563ac330f48dae2
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Jun 27 02:54:23 2012 +0800
refactor to use DateTime::Event::ICal to calculate recurrence
diff --git a/META.yml b/META.yml
index 664c8ef..bceb831 100644
--- a/META.yml
+++ b/META.yml
@@ -19,6 +19,8 @@ no_index:
- etc
- html
- inc
+requires:
+ DateTime::Event::ICal: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
index bd15472..9208e92 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,6 +1,6 @@
use inc::Module::Install;
RTx('RT-Extension-RepeatTicket');
all_from('lib/RT/Extension/RepeatTicket.pm');
-
+requires('DateTime::Event::ICal');
&auto_install();
&WriteAll;
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 32a98a2..5a9b107 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -91,12 +91,11 @@ size="4" value="<% $ARGSRef->{'repeat-details-weekly-week'} || 1 %>" /> <&|/l&>w
<td width="10px" />
% for my $number ( 0 .. 6 ) {
<td>
- <input name="repeat-details-weekly-weeks" type="checkbox" value="<%
-$number %>"
+ <input name="repeat-details-weekly-weeks" type="checkbox" value="<% $week_values[$number] %>"
% if ( defined $ARGSRef->{'repeat-details-weekly-weeks'} && (
-% ( ref $ARGSRef->{'repeat-details-weekly-weeks'} && grep { $_ == $number }
+% ( ref $ARGSRef->{'repeat-details-weekly-weeks'} && grep { $_ eq $week_values[$number] }
% @{$ARGSRef->{'repeat-details-weekly-weeks'}} ) ||
-% ( $ARGSRef->{'repeat-details-weekly-weeks'} == $number ) ) ) {
+% ( $ARGSRef->{'repeat-details-weekly-weeks'} eq $week_values[$number] ) ) ) {
checked="checked"
% }
@@ -123,7 +122,7 @@ $number %>"
<tr>
<td>
<input name="repeat-details-monthly" type="radio" value="day" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'day' ? 'checked="checked"' : '' |n %> /><&|/l&>Day</&>
- <input name="repeat-details-monthly-day-day" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day'} || 1 %>" /> <&|/l&>of every</&>
+ <input name="repeat-details-monthly-day-day" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day-day'} || 1 %>" /> <&|/l&>of every</&>
<input name="repeat-details-monthly-day-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-day-month'} || 1 %>" /> <&|/l&>month(s)</&>
</td>
</tr>
@@ -132,13 +131,14 @@ $number %>"
<input name="repeat-details-monthly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
<select name="repeat-details-monthly-week-number">
% for my $number ( 1 .. 5 ) {
- <option value="<% $number %>" <%($ARGSRef->{'repeat-details-monthly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
+ <option value="<% $number == 5 ? -1 : $number %>" <%($ARGSRef->{'repeat-details-monthly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
% }
</select>
<select name="repeat-details-monthly-week-week">
% for my $number ( 0 .. 6 ) {
- <option value="<% $number %>" <%($ARGSRef->{'repeat-details-monthly-week-week'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
+ <option value="<% $week_values[$number] %>"
+ <%($ARGSRef->{'repeat-details-monthly-week-week'} || '') eq $week_values[$number] ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
% }
</select>
<&|/l&>of every</&><input name="repeat-details-monthly-week-month" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-week-month'} || 1 %>" /> <&|/l&>month(s)</&>
@@ -172,13 +172,14 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
<input name="repeat-details-yearly" type="radio" value="week" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'week' ? 'checked="checked"' : '' |n %> /><&|/l&>The</&>
<select name="repeat-details-yearly-week-number">
% for my $number ( 1 .. 5 ) {
- <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
+ <option value="<% $number == 5 ? -1 : $number %>" <%($ARGSRef->{'repeat-details-yearly-week-number'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_number_labels[$number-1]) %></option>
% }
</select>
<select name="repeat-details-yearly-week-week">
% for my $number ( 0 .. 6 ) {
- <option value="<% $number %>" <%($ARGSRef->{'repeat-details-yearly-week-week'} || '') eq $number ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
+ <option value="<% $week_values[$number] %>"
+ <%($ARGSRef->{'repeat-details-yearly-week-week'} || '') eq $week_values[$number] ? 'selected="selected"' : '' |n %>><% loc($week_labels[$number]) %></option>
% }
</select>
<&|/l&>of</&>
@@ -242,6 +243,7 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
<%init>
my @week_labels = qw/Sunday Monday Tuesday Wedsenday Thursday Friday Saturday/; # loc
+my @week_values = qw/su mo tu we th fr sa/;
my @week_number_labels = qw/First Second Third Fourth Last/; # loc
my @month_labels = qw/January February March April May June July August September October November December/; # loc
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index ea8ac0c..36ba36e 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -9,6 +9,7 @@ use RT::Interface::Web;
use DateTime;
use RT::Date;
use List::MoreUtils qw/after/;
+use DateTime::Event::ICal;
my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
{
@@ -122,35 +123,40 @@ sub Repeat {
my $last_ticket = RT::Ticket->new( RT->SystemUser );
$last_ticket->Load( $content->{'last-ticket'} );
- my $due_date = $checkday->clone;
+ my $last_due;
+ if ( $last_ticket->DueObj->Unix ) {
+ $last_due = DateTime->from_epoch(
+ epoch => $last_ticket->DueObj->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ $last_due->truncate( to => 'day' );
+ }
+ my $last_created = DateTime->from_epoch(
+ epoch => $last_ticket->CreatedObj->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ $last_created->truncate( to => 'day' );
+ next unless $last_created->ymd lt $checkday->ymd;
+
+ my $set;
if ( $content->{'repeat-type'} eq 'daily' ) {
if ( $content->{'repeat-details-daily'} eq 'day' ) {
my $span = $content->{'repeat-details-daily-day'} || 1;
- my $date = $checkday->clone;
-
- unless ( CheckLastTicket( $date, $last_ticket, 'day', $span ) )
- {
- $RT::Logger->debug('Failed last-ticket date check');
- next;
- }
-
- $due_date->add( days => $span );
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'daily',
+ interval => $span,
+ );
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
- unless ( $checkday->day_of_week >= 1
- && $checkday->day_of_week <= 5 )
- {
- $RT::Logger->debug('Failed weekday check');
- next;
- }
-
- if ( $checkday->day_of_week == 5 ) {
- $due_date->add( days => 3 );
- }
- else {
- $due_date->add( days => 1 );
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'daily',
+ byday => [ 'mo', 'tu', 'we', 'th', 'fr' ],
+ );
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-daily'} eq 'complete' ) {
unless ( CheckCompleteStatus($last_ticket) ) {
@@ -176,36 +182,23 @@ sub Repeat {
my $span = $content->{'repeat-details-weekly-week'} || 1;
my $date = $checkday->clone;
- unless ( CheckLastTicket( $date, $last_ticket, 'week', $span ) )
- {
- $RT::Logger->debug('Failed last-ticket date check');
- next;
- }
-
my $weeks = $content->{'repeat-details-weekly-weeks'};
-
unless ( defined $weeks ) {
$RT::Logger->debug('Failed weeks defined check');
next;
}
$weeks = [$weeks] unless ref $weeks;
- unless ( grep { $_ == $checkday->day_of_week % 7 } @$weeks ) {
- $RT::Logger->debug('Failed weeks check');
- next;
- }
- @$weeks = sort @$weeks;
- $due_date->subtract( days => $due_date->day_of_week % 7 );
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'weekly',
+ interval => $span,
+ byday => $weeks,
+ );
+
+ next unless $set->contains($checkday);
- my ($after) = after { $_ == $date->day_of_week % 7 } @$weeks;
- if ($after) {
- $due_date->add( days => $after );
- }
- else {
- $due_date->add( weeks => $span );
- $due_date->add( days => $weeks->[0] );
- }
}
elsif ( $content->{'repeat-details-weekly'} eq 'complete' ) {
unless ( CheckCompleteStatus($last_ticket) ) {
@@ -227,57 +220,33 @@ sub Repeat {
}
elsif ( $content->{'repeat-type'} eq 'monthly' ) {
if ( $content->{'repeat-details-monthly'} eq 'day' ) {
- my $day = $content->{'repeat-details-monthly-day-day'} || 1;
- unless ( $day == $checkday->day_of_month ) {
- $RT::Logger->debug('Failed day of month check');
- next;
- }
-
+ my $day = $content->{'repeat-details-monthly-day-day'} || 1;
my $span = $content->{'repeat-details-monthly-day-month'} || 1;
- my $date = $checkday->clone;
- unless (
- CheckLastTicket( $date, $last_ticket, 'month', $span ) )
- {
- $RT::Logger->debug('Failed last-ticket date check');
- next;
- }
- $due_date->add( months => $span );
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'monthly',
+ interval => $span,
+ bymonthday => $day,
+ );
+
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
- my $day = $content->{'repeat-details-monthly-week-week'} || 0;
- unless ( $day == $checkday->day_of_week % 7 ) {
- $RT::Logger->debug('Failed day of week check');
- next;
- }
-
+ my $day = $content->{'repeat-details-monthly-week-week'}
+ || 'mo';
+ my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $number = $content->{'repeat-details-monthly-week-number'}
|| 1;
- unless ( CheckWeekNumber( $checkday, $number ) ) {
- $RT::Logger->debug('Failed week number check');
- next;
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'monthly',
+ interval => $span,
+ byday => $number . $day,
+ );
- my $span = $content->{'repeat-details-monthly-week-month'} || 1;
- my $date = $checkday->clone;
- unless (
- CheckLastTicket( $date, $last_ticket, 'month', $span ) )
- {
- $RT::Logger->debug('Failed last-ticket date check');
- next;
- }
-
- $due_date->add( months => $span );
- $due_date->truncate( to => 'month' );
- $due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week % 7 ) {
- $due_date->add( days => $day - $due_date->day_of_week % 7 );
- }
- elsif ( $day < $due_date->day_of_week % 7 ) {
- $due_date->add(
- days => 7 + $day - $due_date->day_of_week % 7 );
- }
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-monthly'} eq 'complete' ) {
unless ( CheckCompleteStatus($last_ticket) ) {
@@ -299,49 +268,30 @@ sub Repeat {
}
elsif ( $content->{'repeat-type'} eq 'yearly' ) {
if ( $content->{'repeat-details-yearly'} eq 'day' ) {
- my $day = $content->{'repeat-details-yearly-day-day'} || 1;
- unless ( $day == $checkday->day_of_month ) {
- $RT::Logger->debug('Failed day of month check');
- next;
- }
-
+ my $day = $content->{'repeat-details-yearly-day-day'} || 1;
my $month = $content->{'repeat-details-yearly-day-month'} || 1;
- unless ( $month == $checkday->month ) {
- $RT::Logger->debug('Failed month check');
- next;
- }
- $due_date->add( years => 1 );
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'yearly',
+ bymonth => $month,
+ bymonthday => $day,
+ );
+
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
- my $day = $content->{'repeat-details-yearly-week-week'} || 0;
- unless ( $day == $checkday->day_of_week % 7 ) {
- $RT::Logger->debug('Failed day of week check');
- next;
- }
-
my $month = $content->{'repeat-details-yearly-week-month'} || 1;
- unless ( $month == $checkday->month ) {
- $RT::Logger->debug('Failed month check');
- next;
- }
-
+ my $day = $content->{'repeat-details-yearly-week-week'} || 'mo';
my $number = $content->{'repeat-details-yearly-week-number'}
|| 1;
- unless ( CheckWeekNumber( $checkday, $number ) ) {
- $RT::Logger->debug('Failed week number check');
- next;
- }
-
- $due_date->add( years => 1 );
- $due_date->truncate( to => 'month' );
- $due_date->add( weeks => $number - 1 );
- if ( $day > $due_date->day_of_week % 7 ) {
- $due_date->add( days => $day - $due_date->day_of_week % 7 );
- }
- elsif ( $day < $due_date->day_of_week % 7 ) {
- $due_date->add(
- days => 7 + $day - $due_date->day_of_week % 7 );
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'yearly',
+ bymonth => $month,
+ byday => $number . $day,
+ );
+
+ next unless $set->contains($checkday);
}
elsif ( $content->{'repeat-details-yearly'} eq 'complete' ) {
unless ( CheckCompleteStatus($last_ticket) ) {
@@ -366,15 +316,18 @@ sub Repeat {
my $starts = RT::Date->new( RT->SystemUser );
$starts->Set( Format => 'unknown', Value => $checkday->ymd );
- my $due = RT::Date->new( RT->SystemUser );
- $due->Set( Format => 'unknown', Value => $due_date->ymd );
+ my $due;
+ if ($set) {
+ $due = RT::Date->new( RT->SystemUser );
+ $due->Set( Format => 'unknown', Value => $set->next($checkday) );
+ }
my ( $id, $txn, $msg ) = _RepeatTicket(
$repeat_ticket,
Starts => $starts->ISO,
- $due_date eq $checkday
- ? ()
- : ( Due => $due->ISO ),
+ $due
+ ? ( Due => $due->ISO )
+ : (),
);
if ($id) {
@@ -401,8 +354,8 @@ sub _RepeatTicket {
my $repeat_ticket = shift;
return unless $repeat_ticket;
- my %args = @_;
- my $cf = RT::CustomField->new(RT->SystemUser);
+ my %args = @_;
+ my $cf = RT::CustomField->new( RT->SystemUser );
$cf->Load('Original Ticket');
my $repeat = {
@@ -497,13 +450,20 @@ sub MaybeRepeatMore {
my $last_ticket = RT::Ticket->new( RT->SystemUser );
$last_ticket->Load( $content->{'last-ticket'} );
- my $date =
- $last_ticket->DueObj->Unix
- ? DateTime->from_epoch(
- epoch => $last_ticket->DueObj->Unix - 3600 * 24,
- time_zone => RT->Config->Get('Timezone')
- )
- : DateTime->today( time_zone => RT->Config->Get('Timezone') );
+ my $last_due;
+ if ( $last_ticket->DueObj->Unix ) {
+ $last_due = DateTime->from_epoch(
+ epoch => $last_ticket->DueObj->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ $last_due->truncate( to => 'day' );
+ }
+
+ my $last_created = DateTime->from_epoch(
+ epoch => $last_ticket->CreatedObj->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ $last_created->truncate( to => 'day' );
@$tickets = grep {
my $t = RT::Ticket->new( RT->SystemUser );
@@ -517,219 +477,108 @@ sub MaybeRepeatMore {
my @ids;
if ( $co_number > @$tickets ) {
my $total = $co_number - @$tickets;
- my @dates;
+ my $set;
if ( $content->{'repeat-type'} eq 'daily' ) {
if ( $content->{'repeat-details-daily'} eq 'day' ) {
- my $span = $content->{'repeat-details-daily-day'} || 1;
- for ( 1 .. $total ) {
- $date->add( days => $span );
- push @dates, $date->clone;
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'daily',
+ interval => $content->{'repeat-details-daily-day'} || 1,
+ );
}
elsif ( $content->{'repeat-details-daily'} eq 'weekday' ) {
- while ( @dates < $total ) {
- $date->add( days => 1 );
- push @dates, $date->clone
- if $date->day_of_week >= 1 && $date->day_of_week <= 5;
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'daily',
+ byday => [ 'mo', 'tu', 'we', 'th', 'fr' ],
+ );
}
}
elsif ( $content->{'repeat-type'} eq 'weekly' ) {
if ( $content->{'repeat-details-weekly'} eq 'week' ) {
- my $span = $content->{'repeat-details-weekly-week'} || 1;
my $weeks = $content->{'repeat-details-weekly-weeks'};
if ( defined $weeks ) {
- $weeks = [$weeks] unless ref $weeks;
-
- if ( grep { $_ >= 0 && $_ <= 6 } @$weeks ) {
- $date->add( weeks => $span );
- $date->subtract( days => $date->day_of_week % 7 );
-
- while ( @dates < $total ) {
- for my $day ( sort @$weeks ) {
- push @dates, $date->clone->add( days => $day );
- last if @dates == $total;
- }
-
- $date->add( weeks => $span );
- }
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'weekly',
+ interval => $content->{'repeat-details-weekly-week'}
+ || 1,
+ byday => ref $weeks ? $weeks : [$weeks],
+ );
+ }
+ else {
+ $RT::Logger->error('No weeks defined');
}
}
}
elsif ( $content->{'repeat-type'} eq 'monthly' ) {
if ( $content->{'repeat-details-monthly'} eq 'day' ) {
- my $span = $content->{'repeat-details-monthly-day-month'} || 1;
- $date->set( day => $content->{'repeat-details-monthly-day-day'}
- || 1 );
-
- for ( 1 .. $total ) {
- $date->add( months => $span );
- push @dates, $date->clone;
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'monthly',
+ interval => $content->{'repeat-details-monthly-day-month'}
+ || 1,
+ bymonthday => $content->{'repeat-details-monthly-day-day'}
+ || 1,
+ );
}
elsif ( $content->{'repeat-details-monthly'} eq 'week' ) {
- my $span = $content->{'repeat-details-monthly-week-month'} || 1;
my $number = $content->{'repeat-details-monthly-week-number'}
|| 1;
- my $day = $content->{'repeat-details-monthly-week-week'} || 0;
-
- for ( 1 .. $total ) {
- $date->add( months => $span );
- $date->truncate( to => 'month' );
- $date->add( weeks => $number - 1 );
-
- if ( $day > $date->day_of_week % 7 ) {
- $date->add( days => $day - $date->day_of_week % 7 );
- }
- elsif ( $day < $date->day_of_week % 7 ) {
- $date->add( days => 7 + $day - $date->day_of_week % 7 );
- }
- push @dates, $date->clone;
- }
+ my $day = $content->{'repeat-details-monthly-week-week'}
+ || 'mo';
+
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'monthly',
+ interval => $content->{'repeat-details-monthly-week-month'}
+ || 1,
+ byday => $number . $day,
+ );
}
}
elsif ( $content->{'repeat-type'} eq 'yearly' ) {
if ( $content->{'repeat-details-yearly'} eq 'day' ) {
- $date->set( day => $content->{'repeat-details-yearly-day-day'}
- || 1 );
- $date->set(
- month => $content->{'repeat-details-yearly-day-month'}
- || 1 );
- for ( 1 .. $total ) {
- $date->add( years => 1 );
- push @dates, $date->clone;
- }
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'yearly',
+ bymonth => $content->{'repeat-details-yearly-day-month'}
+ || 1,
+ bymonthday => $content->{'repeat-details-yearly-day-day'}
+ || 1,
+ );
}
elsif ( $content->{'repeat-details-yearly'} eq 'week' ) {
- $date->set(
- month => $content->{'repeat-details-yearly-week-month'}
- || 1 );
-
my $number = $content->{'repeat-details-yearly-week-number'}
|| 1;
- my $day = $content->{'repeat-details-yearly-week-week'} || 0;
-
- for ( 1 .. $total ) {
- $date->add( years => 1 );
- $date->truncate( to => 'month' );
- $date->add( weeks => $number - 1 );
- if ( $day > $date->day_of_week % 7 ) {
- $date->add( days => $day - $date->day_of_week % 7 );
- }
- elsif ( $day < $date->day_of_week % 7 ) {
- $date->add( days => 7 + $day - $date->day_of_week % 7 );
- }
- push @dates, $date->clone;
- }
+ my $day = $content->{'repeat-details-yearly-week-week'} || 'mo';
+
+ $set = DateTime::Event::ICal->recur(
+ dtstart => $last_due || $last_created,
+ freq => 'yearly',
+ bymonth => $content->{'repeat-details-yearly-week-month'}
+ || 1,
+ byday => $number . $day,
+ );
}
}
- for my $date (@dates) {
- push @ids, Repeat( $attr, @dates );
- }
- }
- return @ids;
-}
-
-sub CheckLastTicket {
- my $date = shift;
- my $last_ticket = shift;
- my $type = shift;
- my $span = shift || 1;
-
- if ( $last_ticket->DueObj->Unix ) {
- my $due = $last_ticket->DueObj;
- if ( $date->ymd ge $due->Date( Timezone => 'user' ) ) {
- return 1;
- }
- else {
- return 0;
- }
- }
+ if ($set) {
+ my @dates;
+ my $iter = $set->iterator;
+ while ( my $dt = $iter->next ) {
+ next if $dt == $last_created;
- my $created = DateTime->from_epoch(
- epoch => $last_ticket->CreatedObj->Unix,
- time_zone => RT->Config->Get('Timezone'),
- );
- $created->truncate( to => 'day' );
-
- my $check = $date->clone();
-
- if ( $type eq 'day' ) {
- $check->subtract( days => $span );
- if ( $check->ymd ge $created->ymd ) {
- return 1;
- }
- else {
- return 0;
- }
- }
- elsif ( $type eq 'week' ) {
- my $created_week_start =
- $created->clone->subtract( days => $created->day_of_week % 7 );
- my $check_week_start =
- $check->clone->subtract( days => $check->day_of_week % 7 );
-
- return 0 unless $check_week_start > $created_week_start;
-
- return 1 if $span == 1;
-
- if ( ( $check_week_start->epoch - $created_week_start->epoch )
- % ( $span * 24 * 3600 * 7 ) )
- {
- return 0;
- }
- else {
- return 1;
- }
- }
- elsif ( $type eq 'month' ) {
- my $created_month_start = $created->clone->truncate( to => 'month' );
- my $check_month_start = $check->clone->truncate( to => 'month' );
-
- return 0 unless $check_month_start > $created_month_start;
- return 1 if $span == 1;
-
- if (
- (
- $check->year * 12 +
- $check->month -
- $created->year * 12 -
- $created->month
- ) % $span
- )
- {
- return 0;
- }
- else {
- return 1;
- }
- }
-
-}
+ push @dates, $dt;
+ last if @dates >= $total;
+ }
-sub CheckWeekNumber {
- my $date = shift;
- my $number = shift || 1;
- if ( $number == 5 ) { # last one, not just 5th
- my $next_month =
- $date->clone->truncate( to => 'month' )->add( months => 1 );
- if ( $next_month->epoch - $date->epoch <= 24 * 3600 * 7 ) {
- return 1;
- }
- else {
- return 0;
- }
- }
- else {
- if ( $number == int( ( $date->day_of_month - 1 ) / 7 ) + 1 ) {
- return 1;
- }
- else {
- return 0;
+ for my $date (@dates) {
+ push @ids, Repeat( $attr, @dates );
+ }
}
}
+ return @ids;
}
sub CheckCompleteStatus {
@@ -754,6 +603,7 @@ sub CheckCompleteDate {
return 0
if $resolved->Date( Timezone => 'user' ) gt $date->ymd;
+
return 1;
}
commit ae3c7689eb5f9f1f310d22986aa4c2f2d119f02e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Jun 27 02:56:35 2012 +0800
update doc for script
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket
index adcb7a4..d6ddb0c 100755
--- a/bin/rt-repeat-ticket
+++ b/bin/rt-repeat-ticket
@@ -65,7 +65,8 @@ rt-repeat-ticket - repeat ticket
=head1 SYNOPSIS
- rt-repeat-ticket
+ rt-repeat-ticket # today
+ rt-repeat-ticket --date 2012-06-23
=head1 DESCRIPTION
commit 0b7fee1a0f79c12b7d8059ba1e03d2b77dad73c8
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jun 29 00:06:38 2012 +0800
add `make initdb` as we have initialdata
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 36ba36e..d06603c 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -625,6 +625,7 @@ To install this module, run the following commands:
perl Makefile.PL
make
make install
+ make initdb
add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
commit 7bb3db0b7adab894fcbc1f02dfb9d7d745533ae3
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 13:46:19 2012 -0400
Add name to ModifyRecurrence form
diff --git a/html/Ticket/ModifyRecurrence.html b/html/Ticket/ModifyRecurrence.html
index 9d09e24..f526976 100644
--- a/html/Ticket/ModifyRecurrence.html
+++ b/html/Ticket/ModifyRecurrence.html
@@ -3,7 +3,7 @@
<& /Elements/ListActions, actions => \@results &>
-<form method="post" action="ModifyRecurrence.html">
+<form method="post" name="ModifyRecurrence" action="ModifyRecurrence.html">
<input type="hidden" class="hidden" name="id" value="<%$TicketObj->Id%>" />
<&| /Widgets/TitleBox,title => loc('Modify recurrence for ticket # [_1]', $TicketObj->Id), class=> 'ticket-info-repeat' &>
<& Elements/EditRecurrence, Ticket => $TicketObj &>
commit 1d20d9078e3d194dc6d6b5c2b1e1cbf3ba865aa9
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 14:09:26 2012 -0400
Update META.yml with new t directory
diff --git a/META.yml b/META.yml
index bceb831..8c1dd78 100644
--- a/META.yml
+++ b/META.yml
@@ -19,6 +19,7 @@ no_index:
- etc
- html
- inc
+ - t
requires:
DateTime::Event::ICal: 0
resources:
commit 0ab62efc641cf7ffa6cf987c9e9e67fdcb5e7c44
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 14:47:44 2012 -0400
Add Substitute to update libs in rt-repeat-ticket
diff --git a/Makefile.PL b/Makefile.PL
index 9208e92..cbd56ae 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -2,5 +2,31 @@ use inc::Module::Install;
RTx('RT-Extension-RepeatTicket');
all_from('lib/RT/Extension/RepeatTicket.pm');
requires('DateTime::Event::ICal');
+
+my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
+my $bin_path = $RT::BinPath || "$RT::BasePath/bin" || "/opt/rt4/bin";
+
+# Straight from perldoc perlvar
+use Config;
+my $secure_perl_path = $Config{perlpath};
+if ($^O ne 'VMS') {
+ $secure_perl_path .= $Config{_exe}
+ unless $secure_perl_path =~ m/$Config{_exe}$/i;
+}
+
+substitute(
+ {
+ RT_LIB_PATH => $lib_path,
+ RT_BIN_PATH => $bin_path,
+ PERL => $ENV{PERL} || $secure_perl_path,
+ },
+ {
+ sufix => '.in'
+ },
+ qw(bin/rt-repeat-ticket),
+ qw(lib/RT/Extension/RepeatTicket/Test.pm),
+);
+
&auto_install();
&WriteAll;
diff --git a/bin/rt-repeat-ticket b/bin/rt-repeat-ticket.in
similarity index 93%
rename from bin/rt-repeat-ticket
rename to bin/rt-repeat-ticket.in
index d6ddb0c..97254e5 100755
--- a/bin/rt-repeat-ticket
+++ b/bin/rt-repeat-ticket.in
@@ -1,9 +1,11 @@
#!/usr/bin/env perl
+### before: #!@PERL@
use strict;
use warnings;
-use lib '/opt/rt4/lib';
+### after: use lib qw(@RT_LIB_PATH@);
+use lib '/opt/rt4/local/lib /opt/rt4/lib';
use Getopt::Long;
my %opt;
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..56af7fe
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+ my $self = shift;
+ $self->{__subst} = shift;
+ $self->{__option} = {};
+ if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+ my $opts = shift;
+ while( my ($k,$v) = each( %$opts ) ) {
+ $self->{__option}->{ lc( $k ) } = $v || '';
+ }
+ }
+ $self->_parse_options;
+
+ my @file = @_;
+ foreach my $f (@file) {
+ $self->_rewrite_file( $f );
+ }
+
+ return;
+}
+
+sub _parse_options
+{
+ my $self = shift;
+ my $cwd = Cwd::getcwd();
+ foreach my $t ( qw(from to) ) {
+ $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+ my $d = $self->{__option}->{$t};
+ die "Couldn't read directory '$d'" unless -d $d && -r _;
+ }
+}
+
+sub _rewrite_file
+{
+ my ($self, $file) = @_;
+ my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+ $source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+ unless( -f $source && -r _ ) {
+ print STDERR "Couldn't find file '$source'\n";
+ return;
+ }
+ my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+ return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+ my ($self, $source, $dest) = @_;
+
+ my $mode = (stat($source))[2];
+
+ open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+ print "Open input '$source' file for substitution\n";
+
+ my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+ $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+ close $sfh;
+
+ seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+ open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+ print "Open output '$dest' file for substitution\n";
+
+ while( <$tmpfh> ) {
+ print $dfh $_;
+ }
+ close $dfh;
+ chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+ my ($self, $in, $out, $replace) = @_;
+
+ my @queue = ();
+ my $subst = $self->{'__subst'};
+ my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+ while( my $str = <$in> ) {
+ if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+ my ($action, $nstr) = ($1,$2);
+ $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+ die "Replace action is bad idea for situations when dest is equal to source"
+ if $replace && $action eq 'replace';
+ if( $action eq 'before' ) {
+ die "no line before 'before' action" unless @queue;
+ # overwrite prev line;
+ pop @queue;
+ push @queue, $nstr;
+ push @queue, $str;
+ } elsif( $action eq 'replace' ) {
+ push @queue, $nstr;
+ } elsif( $action eq 'after' ) {
+ push @queue, $str;
+ push @queue, $nstr;
+ # skip one line;
+ <$in>;
+ }
+ } else {
+ push @queue, $str;
+ }
+ while( @queue > 3 ) {
+ print $out shift(@queue);
+ }
+ }
+ while( scalar @queue ) {
+ print $out shift(@queue);
+ }
+}
+
+1;
+
commit e1f8c9b5532644c1521a870faa376cb4439a8408
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 14:52:46 2012 -0400
Make rt-repeat-ticket a modulino
Give rt-repeat-ticket a run subroutine to make it easy
to call from tests the same way it is called from
command line.
diff --git a/bin/rt-repeat-ticket.in b/bin/rt-repeat-ticket.in
index 97254e5..a78771f 100755
--- a/bin/rt-repeat-ticket.in
+++ b/bin/rt-repeat-ticket.in
@@ -4,61 +4,79 @@
use strict;
use warnings;
+package RT::Repeat::Ticket::Run;
+
+BEGIN {
### after: use lib qw(@RT_LIB_PATH@);
use lib '/opt/rt4/local/lib /opt/rt4/lib';
-
-use Getopt::Long;
-my %opt;
-GetOptions( \%opt, 'help|h', 'date=s' );
-
-if ( $opt{help} ) {
- require Pod::Usage;
- Pod::Usage::pod2usage( { verbose => 2 } );
- exit;
+use RT;
+RT::LoadConfig;
+RT::Init;
}
-require RT;
-RT::LoadConfig();
-RT::Init();
-
use RT::Attributes;
use RT::Date;
+use RT::Extension::RepeatTicket;
-my $attrs = RT::Attributes->new( RT->SystemUser );
-$attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
+__PACKAGE__->run(@ARGV) unless caller;
-use RT::Extension::RepeatTicket;
-my $date;
-if ( $opt{date} ) {
- my $d = RT::Date->new( RT->SystemUser );
- $d->Set(
- Format => 'unknown',
- Value => $opt{date},
- );
-
- # can't use ->Unix because timezone issue
- # where $d->Unix could return a small seconds after 1970-01-01 00:00:00 UTC
- # if date parse fails
- if ( $d->Date ne '1970-01-01' ) {
- $date = DateTime->from_epoch(
- epoch => $d->Unix,
- time_zone => RT->Config->Get('Timezone'),
- );
+sub run{
+ my ($class, @args) = @_;
+
+ my %args = $class->process_args(@args);
+
+ my $attrs = RT::Attributes->new( RT->SystemUser );
+ $attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
+
+ while ( my $attr = $attrs->Next ) {
+ next unless $attr->Content->{'repeat-enabled'};
+ $RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
+ my @ids = RT::Extension::RepeatTicket::Run( $attr, $args{date} );
+ if ( @ids ) {
+ $RT::Logger->info(
+ 'Repeated ticket ' . $attr->Object->id . ': ' . join ', ', @ids );
+ }
}
+ return;
}
-$date ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
+sub process_args{
+ require Getopt::Long;
+ local @ARGV = @_;
+
+ my %opt;
+ Getopt::Long::GetOptions( \%opt, 'help|h', 'date=s' );
-while ( my $attr = $attrs->Next ) {
- next unless $attr->Content->{'repeat-enabled'};
- $RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
- my @ids = RT::Extension::RepeatTicket::Run( $attr, $date );
- if ( @ids ) {
- $RT::Logger->info(
- 'Repeated ticket ' . $attr->Object->id . ': ' . join ', ', @ids );
+ if ( $opt{help} ) {
+ require Pod::Usage;
+ Pod::Usage::pod2usage( { verbose => 2 } );
+ exit;
}
+
+ my %args;
+ if ( $opt{date} ) {
+ my $d = RT::Date->new( RT->SystemUser );
+ $d->Set(
+ Format => 'unknown',
+ Value => $opt{date},
+ );
+
+ # can't use ->Unix because timezone issue
+ # where $d->Unix could return a small seconds after 1970-01-01 00:00:00 UTC
+ # if date parse fails
+ if ( $d->Date ne '1970-01-01' ) {
+ $args{date} = DateTime->from_epoch(
+ epoch => $d->Unix,
+ time_zone => RT->Config->Get('Timezone'),
+ );
+ }
+ }
+ $args{date} ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
+ return %args;
}
+1;
+
__END__
=head1 NAME
commit 30c3417e629d35b3a5e80ed1df0e0b22fe1b1949
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 15:00:19 2012 -0400
Add tests for daily recurrence
diff --git a/lib/RT/Extension/RepeatTicket/Test.pm.in b/lib/RT/Extension/RepeatTicket/Test.pm.in
new file mode 100644
index 0000000..0f4ef53
--- /dev/null
+++ b/lib/RT/Extension/RepeatTicket/Test.pm.in
@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
+
+package RT::Extension::RepeatTicket::Test;
+
+our @ISA;
+BEGIN {
+ local $@;
+ eval { require RT::Test; 1 } or do {
+ require Test::More;
+ Test::More::BAIL_OUT(
+ "requires 3.8 to run tests. Error:\n$@\n"
+ ."You may need to set PERL5LIB=/path/to/rt/lib"
+ );
+ };
+ push @ISA, 'RT::Test';
+}
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ $args{'requires'} ||= [];
+ if ( $args{'testing'} ) {
+ unshift @{ $args{'requires'} }, 'RT::Extension::RepeatTicket';
+ } else {
+ $args{'testing'} = 'RT::Extension::RepeatTicket';
+ }
+
+ $class->SUPER::import( %args );
+ $class->export_to_level(1);
+
+ require RT::Extension::RepeatTicket;
+}
+
+1;
diff --git a/t/daily.t b/t/daily.t
new file mode 100644
index 0000000..0f03051
--- /dev/null
+++ b/t/daily.t
@@ -0,0 +1,89 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 35;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+{
+ my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ diag "Run with default coexist value of 1";
+ my $daily_id = run_tests($baseurl, $m);
+
+ ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
+
+ my $next_id = $daily_id + 1;
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ ok( !($ticket->Load($next_id)), "No ticket created for today.");
+
+ my $tomorrow = DateTime->now->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
+ ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created for tomorrow.");
+ $m->text_like( qr/Set up recurring aperture maintenance/);
+}
+
+RT::Test->stop_server;
+
+{
+ RT->Config->Set('RepeatTicketCoexistentNumber', 2);
+ my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ diag "Run with Coexistent value of 2";
+ my $daily_id = run_tests($baseurl, $m);
+ ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
+
+ my $second = $daily_id + 1;
+ ok( $m->goto_ticket($second), 'Recurrence ticket created for today.');
+ $m->text_like( qr/Set up recurring aperture maintenance/);
+
+ my $tomorrow = DateTime->now->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
+
+ my $third = $daily_id + 2;
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ ok( !($ticket->Load($third)), "Third ticket $third not created.");
+
+ $ticket->Load($second);
+ ok($ticket->SetStatus('resolved'), "Ticket $third resolved");
+ ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
+
+ ok( $m->goto_ticket($third), "Recurrence ticket $third created.");
+ $m->text_like( qr/Set up recurring aperture maintenance/);
+ RT::Test->stop_server;
+}
+
+
+sub run_tests{
+ my ($baseurl, $m) = @_;
+
+ ok( $m->login( 'root', 'password' ), 'logged in' );
+
+ $m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+ $m->content_contains('Enable Recurrence');
+
+ diag "Create a ticket with a recurrence in the General queue.";
+
+ $m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up recurring aperture maintenance',
+ 'Content' => 'Perform work on portals once per day',
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'daily',
+ 'repeat-details-daily' => 'day',
+ 'repeat-details-daily-day' => 1,
+ },}, 'Create');
+
+ $m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+ my ($daily_id) = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ ok($daily_id, "Created ticket with id: $daily_id");
+ return $daily_id;
+}
commit 21dec2db6c730b8003dd1ee363ad559300eb0ef8
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 2 15:59:20 2012 -0400
Ignore generated rt-repeat-ticket and Test.pm files
diff --git a/.gitignore b/.gitignore
index 44c9c19..3d3ce81 100644
--- a/.gitignore
+++ b/.gitignore
@@ -10,3 +10,5 @@ pm_to_blib*
cover_db
pod2htm*.tmp
RT-Extension-RepeatTicket-*
+/bin/rt-repeat-ticket
+/lib/RT/Extension/RepeatTicket/Test.pm
commit b5a32a116ce1383ced02aa429f68c9dd6dbfa7b0
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Jul 4 00:23:33 2012 +0800
allow to disable coexistent number
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index d06603c..c162a0b 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -444,7 +444,9 @@ sub MaybeRepeatMore {
my $attr = shift;
my $content = $attr->Content;
- my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
+ my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber');
+ return unless $co_number;
+
my $tickets = $content->{tickets} || [];
my $last_ticket = RT::Ticket->new( RT->SystemUser );
commit 34b25830deae9efb644b67843eca142e08ab5748
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Jul 4 00:50:45 2012 +0800
coexistent number config at ticket level
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 5a9b107..aadfba4 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -25,6 +25,10 @@ jQuery( function () {
<input name="repeat-enabled" type="checkbox" value="1" <% $ARGSRef->{'repeat-enabled'} ? 'checked="checked"' : '' |n %>/> <&|/l&>Enable Recurrence?</&>
<div class="repeat-toggle <% $ARGSRef->{'repeat-enabled'} ? '' : 'hidden' %> ">
+
+<&|/l&>Coexistent number</&>:
+<input size="3" name="repeat-coexistent-number" type="text" value="<% $ARGSRef->{'repeat-coexistent-number'} %>" />
+
<fieldset>
<legend><&|/l&>Recurrence pattern</&></legend>
<table width="100%" border="0">
@@ -263,6 +267,9 @@ $ARGSRef->{'repeat-details-weekly'} ||= 'week';
$ARGSRef->{'repeat-details-monthly'} ||= 'day';
$ARGSRef->{'repeat-details-yearly'} ||= 'day';
$ARGSRef->{'repeat-end'} ||= 'none';
+
+$ARGSRef->{'repeat-coexistent-number'} ||= RT->Config->Get('RepeatTicketCoexistentNumber') || 0;
+
</%init>
<%args>
$ARGSRef => undef
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index c162a0b..b8a812f 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -444,7 +444,10 @@ sub MaybeRepeatMore {
my $attr = shift;
my $content = $attr->Content;
- my $co_number = RT->Config->Get('RepeatTicketCoexistentNumber');
+ my $co_number = $content->{'repeat-coexistent-number'};
+ $co_number = RT->Config->Get('RepeatTicketCoexistentNumber')
+ unless defined $co_number && length $co_number; # respect 0 but ''
+
return unless $co_number;
my $tickets = $content->{tickets} || [];
commit 9de938406c6566e8af4d5fa6965618964fddea39
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jul 20 23:21:01 2012 +0800
add --type and --ticket options to repeat part of them
diff --git a/bin/rt-repeat-ticket.in b/bin/rt-repeat-ticket.in
index a78771f..beb17fa 100755
--- a/bin/rt-repeat-ticket.in
+++ b/bin/rt-repeat-ticket.in
@@ -30,6 +30,10 @@ sub run{
while ( my $attr = $attrs->Next ) {
next unless $attr->Content->{'repeat-enabled'};
+ next if $args{ticket} && $args{ticket} != $attr->Object->id;
+ next
+ if $args{type} && $args{type} ne $attr->Content->{'repeat-type'};
+
$RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
my @ids = RT::Extension::RepeatTicket::Run( $attr, $args{date} );
if ( @ids ) {
@@ -40,20 +44,19 @@ sub run{
return;
}
-sub process_args{
+sub process_args {
require Getopt::Long;
local @ARGV = @_;
my %opt;
- Getopt::Long::GetOptions( \%opt, 'help|h', 'date=s' );
+ Getopt::Long::GetOptions( \%opt, 'help|h', 'date=s', 'type=s', 'ticket=s' );
- if ( $opt{help} ) {
+ if ( delete $opt{help} ) {
require Pod::Usage;
Pod::Usage::pod2usage( { verbose => 2 } );
exit;
}
- my %args;
if ( $opt{date} ) {
my $d = RT::Date->new( RT->SystemUser );
$d->Set(
@@ -65,14 +68,15 @@ sub process_args{
# where $d->Unix could return a small seconds after 1970-01-01 00:00:00 UTC
# if date parse fails
if ( $d->Date ne '1970-01-01' ) {
- $args{date} = DateTime->from_epoch(
+ $opt{date} = DateTime->from_epoch(
epoch => $d->Unix,
time_zone => RT->Config->Get('Timezone'),
);
}
}
- $args{date} ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
- return %args;
+ $opt{date} ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
+
+ return %opt;
}
1;
@@ -86,7 +90,9 @@ rt-repeat-ticket - repeat ticket
=head1 SYNOPSIS
rt-repeat-ticket # today
+ rt-repeat-ticket --type daily # repeat ticket that has repeat type 'daily'
rt-repeat-ticket --date 2012-06-23
+ rt-repeat-ticket --ticket 20 # repeat ticket 20
=head1 DESCRIPTION
commit 12a78ff937444869a3c156783288fd3cc21a52c8
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jul 20 23:22:12 2012 +0800
we use date, not time
diff --git a/bin/rt-repeat-ticket.in b/bin/rt-repeat-ticket.in
index beb17fa..e37cb19 100755
--- a/bin/rt-repeat-ticket.in
+++ b/bin/rt-repeat-ticket.in
@@ -71,7 +71,7 @@ sub process_args {
$opt{date} = DateTime->from_epoch(
epoch => $d->Unix,
time_zone => RT->Config->Get('Timezone'),
- );
+ )->truncate(to => 'day');
}
}
$opt{date} ||= DateTime->today( time_zone => RT->Config->Get('Timezone') );
commit 25a878035218641701b8571648c3bbc71140f610
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Jul 20 23:40:47 2012 +0800
tiny tweak of words
diff --git a/bin/rt-repeat-ticket.in b/bin/rt-repeat-ticket.in
index e37cb19..79c8b3d 100755
--- a/bin/rt-repeat-ticket.in
+++ b/bin/rt-repeat-ticket.in
@@ -90,7 +90,7 @@ rt-repeat-ticket - repeat ticket
=head1 SYNOPSIS
rt-repeat-ticket # today
- rt-repeat-ticket --type daily # repeat ticket that has repeat type 'daily'
+ rt-repeat-ticket --type daily # repeat tickets of repeat type 'daily'
rt-repeat-ticket --date 2012-06-23
rt-repeat-ticket --ticket 20 # repeat ticket 20
commit 3c6ece5a2f5452c7729cec5ba907af5b27253d7f
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Jul 12 10:46:36 2012 -0400
Change label for concurrent active tickets.
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index aadfba4..6e49c5f 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -26,7 +26,7 @@ jQuery( function () {
<div class="repeat-toggle <% $ARGSRef->{'repeat-enabled'} ? '' : 'hidden' %> ">
-<&|/l&>Coexistent number</&>:
+<&|/l&>Concurrent active tickets</&>:
<input size="3" name="repeat-coexistent-number" type="text" value="<% $ARGSRef->{'repeat-coexistent-number'} %>" />
<fieldset>
commit d958d8a41106da39247aa13f9e1813bc9cff8c2a
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Jul 12 11:57:54 2012 -0400
Make the Recurrence tab a link
diff --git a/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn b/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
index 42ecb73..672f4ac 100644
--- a/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
+++ b/html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
@@ -1,7 +1,10 @@
-<&| /Widgets/TitleBox, title => loc("Recurrence"), class=>'ticket-info-repeat-recurrence' &>
+<&| /Widgets/TitleBox, title => loc("Recurrence"), class=>'ticket-info-repeat-recurrence',
+ ($can_modify ? (title_href => RT->Config->Get('WebPath')."/Ticket/ModifyRecurrence.html?id=".$Ticket->Id) : ()) &>
<& /Ticket/Elements/EditRecurrence, Ticket => $Ticket, ReadOnly => 1 &>
</&>
-
<%args>
$Ticket
</%args>
+<%init>
+my $can_modify = $Ticket->CurrentUserHasRight('ModifyTicket');
+</%init>
commit 6a4d30e5d54a7577de795cb31c24e2ebda40c3fa
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Jul 12 11:58:29 2012 -0400
Update daily tests for new concurrent number per ticket
diff --git a/t/daily.t b/t/daily.t
index 0f03051..83672a4 100644
--- a/t/daily.t
+++ b/t/daily.t
@@ -1,14 +1,13 @@
use strict;
use warnings;
-use RT::Extension::RepeatTicket::Test tests => 35;
+use RT::Extension::RepeatTicket::Test tests => 37;
use_ok('RT::Extension::RepeatTicket');
require_ok('bin/rt-repeat-ticket');
+my ( $baseurl, $m ) = RT::Test->started_ok();
{
- my ( $baseurl, $m ) = RT::Test->started_ok();
-
diag "Run with default coexist value of 1";
my $daily_id = run_tests($baseurl, $m);
@@ -24,18 +23,23 @@ require_ok('bin/rt-repeat-ticket');
$m->text_like( qr/Set up recurring aperture maintenance/);
}
-RT::Test->stop_server;
-
{
- RT->Config->Set('RepeatTicketCoexistentNumber', 2);
- my ( $baseurl, $m ) = RT::Test->started_ok();
-
diag "Run with Coexistent value of 2";
my $daily_id = run_tests($baseurl, $m);
+
+ # Set concurrent active tickets to 2.
+ ok( $m->goto_ticket($daily_id), "Found ticket $daily_id.");
+ $m->follow_link_ok( {text => 'Recurrence'}, 'Loaded recurrence edit' );
+
+ $m->form_name("ModifyRecurrence");
+ $m->field('repeat-coexistent-number' => 2);
+ $m->click_button(name => 'SubmitTicket');
+ $m->text_like( qr/Recurrence updated/);
+
ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
my $second = $daily_id + 1;
- ok( $m->goto_ticket($second), 'Recurrence ticket created for today.');
+ ok( $m->goto_ticket($second), 'Recurrence ticket $second created for today.');
$m->text_like( qr/Set up recurring aperture maintenance/);
my $tomorrow = DateTime->now->add( days => 1 );
@@ -46,12 +50,11 @@ RT::Test->stop_server;
ok( !($ticket->Load($third)), "Third ticket $third not created.");
$ticket->Load($second);
- ok($ticket->SetStatus('resolved'), "Ticket $third resolved");
+ ok($ticket->SetStatus('resolved'), "Ticket $second resolved");
ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
ok( $m->goto_ticket($third), "Recurrence ticket $third created.");
$m->text_like( qr/Set up recurring aperture maintenance/);
- RT::Test->stop_server;
}
commit d64a96cee44a403c566f86b4d11bb8d49dc3cb92
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Jul 13 16:59:54 2012 -0400
Refactor code to get tickets needed to meet coexistent number
Create subs to calculate tickets needed to meet the coexistent
number for the recurrence.
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index b8a812f..5d8a5d7 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -350,6 +350,34 @@ sub Repeat {
return @ids;
}
+sub TicketsToMeetCoexistentNumber {
+ my $attr = shift;
+ my $content = $attr->Content;
+
+ my $co_number = $content->{'repeat-coexistent-number'};
+ $co_number = RT->Config->Get('RepeatTicketCoexistentNumber')
+ unless defined $co_number && length $co_number; # respect 0 but ''
+
+ return unless $co_number;
+
+ my $tickets = GetActiveTickets($content);
+
+ return $co_number - @$tickets;
+}
+
+sub GetActiveTickets {
+ my $content = shift;
+
+ my $tickets_ref = $content->{tickets} || [];
+ @$tickets_ref = grep {
+ my $t = RT::Ticket->new( RT->SystemUser );
+ $t->Load($_);
+ !$t->QueueObj->Lifecycle->IsInactive( $t->Status );
+ } @$tickets_ref;
+
+ return $tickets_ref;
+}
+
sub _RepeatTicket {
my $repeat_ticket = shift;
return unless $repeat_ticket;
@@ -444,13 +472,7 @@ sub MaybeRepeatMore {
my $attr = shift;
my $content = $attr->Content;
- my $co_number = $content->{'repeat-coexistent-number'};
- $co_number = RT->Config->Get('RepeatTicketCoexistentNumber')
- unless defined $co_number && length $co_number; # respect 0 but ''
-
- return unless $co_number;
-
- my $tickets = $content->{tickets} || [];
+ my $tickets_needed = TicketsToMeetCoexistentNumber($attr);
my $last_ticket = RT::Ticket->new( RT->SystemUser );
$last_ticket->Load( $content->{'last-ticket'} );
@@ -470,18 +492,11 @@ sub MaybeRepeatMore {
);
$last_created->truncate( to => 'day' );
- @$tickets = grep {
- my $t = RT::Ticket->new( RT->SystemUser );
- $t->Load($_);
- !$t->QueueObj->Lifecycle->IsInactive( $t->Status );
- } @$tickets;
-
- $content->{tickets} = $tickets;
+ $content->{tickets} = GetActiveTickets($content);
$attr->SetContent($content);
my @ids;
- if ( $co_number > @$tickets ) {
- my $total = $co_number - @$tickets;
+ if ( $tickets_needed ) {
my $set;
if ( $content->{'repeat-type'} eq 'daily' ) {
if ( $content->{'repeat-details-daily'} eq 'day' ) {
@@ -575,7 +590,7 @@ sub MaybeRepeatMore {
next if $dt == $last_created;
push @dates, $dt;
- last if @dates >= $total;
+ last if @dates >= $tickets_needed;
}
for my $date (@dates) {
commit 4ac6adbb199bea0e224568c660dadf0618927691
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 16 11:02:27 2012 -0400
Apply ticket coexist check in Repeat sub
Make the Repeat sub respect the coexist value.
Set the default coexist value to 1.
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 6e49c5f..74a7787 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -267,8 +267,7 @@ $ARGSRef->{'repeat-details-weekly'} ||= 'week';
$ARGSRef->{'repeat-details-monthly'} ||= 'day';
$ARGSRef->{'repeat-details-yearly'} ||= 'day';
$ARGSRef->{'repeat-end'} ||= 'none';
-
-$ARGSRef->{'repeat-coexistent-number'} ||= RT->Config->Get('RepeatTicketCoexistentNumber') || 0;
+$ARGSRef->{'repeat-coexistent-number'} ||= RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
</%init>
<%args>
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 5d8a5d7..02d079a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -82,6 +82,9 @@ sub Repeat {
my $repeat_ticket = $attr->Object;
+ my $tickets_needed = TicketsToMeetCoexistentNumber($attr);
+ return unless $tickets_needed;
+
for my $checkday (@checkdays) {
$RT::Logger->debug( 'checking ' . $checkday->ymd );
@@ -357,11 +360,9 @@ sub TicketsToMeetCoexistentNumber {
my $co_number = $content->{'repeat-coexistent-number'};
$co_number = RT->Config->Get('RepeatTicketCoexistentNumber')
unless defined $co_number && length $co_number; # respect 0 but ''
-
return unless $co_number;
my $tickets = GetActiveTickets($content);
-
return $co_number - @$tickets;
}
diff --git a/t/daily.t b/t/daily.t
index 83672a4..9740e28 100644
--- a/t/daily.t
+++ b/t/daily.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Extension::RepeatTicket::Test tests => 37;
+use RT::Extension::RepeatTicket::Test tests => 41;
use_ok('RT::Extension::RepeatTicket');
require_ok('bin/rt-repeat-ticket');
@@ -11,6 +11,8 @@ my ( $baseurl, $m ) = RT::Test->started_ok();
diag "Run with default coexist value of 1";
my $daily_id = run_tests($baseurl, $m);
+ # No additional tickets should be created with a coexist value of 1.
+
ok(!(RT::Repeat::Ticket::Run->run()), 'Ran recurrence script for today.');
my $next_id = $daily_id + 1;
@@ -19,7 +21,12 @@ my ( $baseurl, $m ) = RT::Test->started_ok();
my $tomorrow = DateTime->now->add( days => 1 );
ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
- ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created for tomorrow.");
+ ok( !($ticket->Load($next_id)), "No ticket created for tomorrow.");
+
+ ok( $ticket->Load($daily_id), "Loaded ticket $daily_id");
+ ok($ticket->SetStatus('resolved'), "Ticket $daily_id resolved");
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
+ ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created for today.");
$m->text_like( qr/Set up recurring aperture maintenance/);
}
commit 82d4b6301928aeb52bfa0a5dab79aa8f0e702abd
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 16 16:58:07 2012 -0400
Add lead time value per recurrence
Add lead time option and tests for weekly, monthly.
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 74a7787..7dd5f5e 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -26,6 +26,8 @@ jQuery( function () {
<div class="repeat-toggle <% $ARGSRef->{'repeat-enabled'} ? '' : 'hidden' %> ">
+<&|/l&>Ticket lead time (days)</&>:
+<input size="3" name="repeat-lead-time" type="text" value="<% $ARGSRef->{'repeat-lead-time'} %>" />
<&|/l&>Concurrent active tickets</&>:
<input size="3" name="repeat-coexistent-number" type="text" value="<% $ARGSRef->{'repeat-coexistent-number'} %>" />
@@ -267,6 +269,7 @@ $ARGSRef->{'repeat-details-weekly'} ||= 'week';
$ARGSRef->{'repeat-details-monthly'} ||= 'day';
$ARGSRef->{'repeat-details-yearly'} ||= 'day';
$ARGSRef->{'repeat-end'} ||= 'none';
+$ARGSRef->{'repeat-lead-time'} ||= RT->Config->Get('RepeatTicketLeadTime') || 14;
$ARGSRef->{'repeat-coexistent-number'} ||= RT->Config->Get('RepeatTicketCoexistentNumber') || 1;
</%init>
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 02d079a..d4473c0 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -25,7 +25,7 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
'last-ticket' => $ticket->id,
map { $_ => $args{$_} } grep { /^repeat/ } keys %args
);
- MaybeRepeatMore($attr);
+ Run($attr);
}
return ( $ticket, @actions );
};
@@ -86,7 +86,12 @@ sub Repeat {
return unless $tickets_needed;
for my $checkday (@checkdays) {
- $RT::Logger->debug( 'checking ' . $checkday->ymd );
+ # Adjust by lead time
+ my $original_date = $checkday->clone();
+ $checkday = $checkday->add( days => $content->{'repeat-lead-time'} )
+ if defined $content->{'repeat-lead-time'};
+ $RT::Logger->debug( 'Checking date ' . $original_date ->ymd .
+ ' with adjusted lead time date ' . $checkday->ymd );
if ( $content->{'repeat-start-date'} ) {
my $date = RT::Date->new( RT->SystemUser );
@@ -95,7 +100,7 @@ sub Repeat {
Value => $content->{'repeat-start-date'},
);
if ( $checkday->ymd lt $date->Date ) {
- $RT::Logger->debug('Failed repeat-start-date check');
+ $RT::Logger->debug('Not yet at start date' . $date->Date);
next;
}
}
@@ -117,7 +122,7 @@ sub Repeat {
Value => $content->{'repeat-end-date'},
);
- if ( $checkday->ymd gt $date->Date ) {
+ if ( $original_date->ymd gt $date->Date ) {
$RT::Logger->debug('Failed repeat-end-date check');
next;
}
@@ -317,12 +322,12 @@ sub Repeat {
# use RT::Date to work around the timezone issue
my $starts = RT::Date->new( RT->SystemUser );
- $starts->Set( Format => 'unknown', Value => $checkday->ymd );
+ $starts->Set( Format => 'unknown', Value => $original_date->ymd );
my $due;
if ($set) {
$due = RT::Date->new( RT->SystemUser );
- $due->Set( Format => 'unknown', Value => $set->next($checkday) );
+ $due->Set( Format => 'unknown', Value => $checkday );
}
my ( $id, $txn, $msg ) = _RepeatTicket(
@@ -362,7 +367,7 @@ sub TicketsToMeetCoexistentNumber {
unless defined $co_number && length $co_number; # respect 0 but ''
return unless $co_number;
- my $tickets = GetActiveTickets($content);
+ my $tickets = GetActiveTickets($content) || 0;
return $co_number - @$tickets;
}
@@ -472,7 +477,6 @@ sub _RepeatTicket {
sub MaybeRepeatMore {
my $attr = shift;
my $content = $attr->Content;
-
my $tickets_needed = TicketsToMeetCoexistentNumber($attr);
my $last_ticket = RT::Ticket->new( RT->SystemUser );
diff --git a/t/daily.t b/t/daily.t
index 9740e28..acbd9d9 100644
--- a/t/daily.t
+++ b/t/daily.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Extension::RepeatTicket::Test tests => 41;
+use RT::Extension::RepeatTicket::Test tests => 43;
use_ok('RT::Extension::RepeatTicket');
require_ok('bin/rt-repeat-ticket');
@@ -26,8 +26,15 @@ my ( $baseurl, $m ) = RT::Test->started_ok();
ok( $ticket->Load($daily_id), "Loaded ticket $daily_id");
ok($ticket->SetStatus('resolved'), "Ticket $daily_id resolved");
ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
- ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created for today.");
+ ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created for tomorrow.");
$m->text_like( qr/Set up recurring aperture maintenance/);
+
+ my $ticket2 = RT::Ticket->new(RT->SystemUser);
+ $ticket2->Load($next_id);
+
+ is($ticket2->StartsObj->ISO(Time => 0), $tomorrow->ymd, 'Starts tomorrow');
+ $tomorrow->add( days => 14 );
+ is( $ticket2->DueObj->ISO(Time => 0), $tomorrow->ymd, 'Due in default 14 days');
}
{
@@ -95,5 +102,10 @@ sub run_tests{
my ($daily_id) = $m->content =~ /Ticket\s(\d+)\screated in queue/;
ok($daily_id, "Created ticket with id: $daily_id");
+
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ $ticket->Load($daily_id);
+
+
return $daily_id;
}
diff --git a/t/monthly.t b/t/monthly.t
new file mode 100644
index 0000000..bbd5c8c
--- /dev/null
+++ b/t/monthly.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 20;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+$m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+$m->content_contains('Enable Recurrence');
+
+diag "Create a ticket with a recurrence in the General queue.";
+
+my $day = DateTime->now;
+$m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up monthly aperture maintenance',
+ 'Content' => 'Perform work on portals on the first of each month',
+ 'repeat-lead-time' => 14,
+ 'repeat-coexistent-number' => 1,
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'monthly',
+ 'repeat-details-monthly-day-day' => $day->day,
+ 'repeat-details-monthly-day-month' => 1,
+ },}, 'Create');
+
+$m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+my $monthly_id = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ok($monthly_id, "Created ticket with id: $monthly_id");
+
+my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ok( $ticket1->Load($monthly_id), "Loaded ticket $monthly_id");
+ok($ticket1->SetStatus('resolved'), "Ticket $monthly_id resolved");
+
+# This is to get the day 14 days before the next recurrence to match lead time.
+# DateTime cautions there are times when adding and subtracting are not 100%
+# reversible.
+$day->add( months => 1 );
+$day->subtract( days => 14 );
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)), 'Ran recurrence script for: ' . $day->ymd);
+
+my $second = $monthly_id + 1;
+ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
+
+my $ticket2 = RT::Ticket->new(RT->SystemUser);
+$ticket2->Load($second);
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts 14 days before due: ' . $day->ymd);
+$day->add( days => 14 );
+is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due on: ' . $day->ymd);
diff --git a/t/weekly.t b/t/weekly.t
new file mode 100644
index 0000000..8767b65
--- /dev/null
+++ b/t/weekly.t
@@ -0,0 +1,86 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 26;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+$m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+$m->content_contains('Enable Recurrence');
+
+diag "Create a ticket with a recurrence in the General queue.";
+
+$m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up recurring aperture maintenance',
+ 'Content' => 'Perform work on portals on Tuesday and Thursday',
+ 'repeat-lead-time' => 7,
+ 'repeat-coexistent-number' => 2,
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'weekly',
+ 'repeat-details-weekly' => 'week',
+ 'repeat-details-weekly-week' => 1,
+ 'repeat-details-weekly-weeks' => 'th',
+ },}, 'Create');
+
+$m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+my $weekly_id = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ok($weekly_id, "Created ticket with id: $weekly_id");
+
+# Submiting the form with concurrent = 2 runs the create
+my $second = $weekly_id + 1;
+ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
+
+my $ticket2 = RT::Ticket->new(RT->SystemUser);
+$ticket2->Load($second);
+my $day = DateTime->now;
+GetThursday($day);
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+$day->add( days => 7 );
+is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+
+my $tomorrow = DateTime->now->add( days => 1 );
+my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ok( $ticket1->Load($weekly_id), "Loaded ticket $weekly_id");
+ok($ticket1->SetStatus('resolved'), "Ticket $weekly_id resolved");
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
+
+my $third = $weekly_id + 2;
+ok( $m->goto_ticket($third), "Recurrence ticket $third created.");
+$m->text_like( qr/Set up recurring aperture maintenance/);
+
+my $ticket3 = RT::Ticket->new(RT->SystemUser);
+$ticket3->Load($third);
+GetThursday($day);
+is($ticket3->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+$day->add( days => 7 );
+is( $ticket3->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+
+my $thurs = DateTime->now;
+GetThursday($thurs);
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $thurs->ymd)), 'Ran recurrence script for next Thursday.');
+my $ticket4 = RT::Ticket->new(RT->SystemUser);
+ok(!($ticket4->Load($third + 1)), 'No fourth ticket created.');
+
+
+# Didn't want to add DateTime::Format::Natural as a dependency.
+sub GetThursday {
+ my $dt = shift;
+
+ foreach (1..7){
+ return if $dt->day_of_week == 4;
+ $dt->add( days => 1);
+ }
+}
commit 3ea96b8959b5f4900195319e3236d84c453e0a79
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Jul 17 07:28:10 2012 -0400
Add tests for yearly recurrence
diff --git a/t/yearly.t b/t/yearly.t
new file mode 100644
index 0000000..ff3ed94
--- /dev/null
+++ b/t/yearly.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 20;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+$m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+$m->content_contains('Enable Recurrence');
+
+diag "Create a ticket with a recurrence in the General queue.";
+
+my $day = DateTime->now;
+$m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up monthly aperture maintenance',
+ 'Content' => 'Perform work on portals on the first of each month',
+ 'repeat-lead-time' => 21,
+ 'repeat-coexistent-number' => 1,
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'yearly',
+ 'repeat-details-yearly-day-month' => $day->month,
+ 'repeat-details-yearly-day-day' => $day->day,
+ },}, 'Create');
+
+$m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+my $yearly_id = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ok($yearly_id, "Created ticket with id: $yearly_id");
+
+my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ok( $ticket1->Load($yearly_id), "Loaded ticket $yearly_id");
+ok($ticket1->SetStatus('resolved'), "Ticket $yearly_id resolved");
+
+# This is to get the day 21 days before the next recurrence to match lead time.
+# DateTime cautions there are times when adding and subtracting are not 100%
+# reversible.
+$day->add( years => 1 );
+$day->subtract( days => 21 );
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)), 'Ran recurrence script for: ' . $day->ymd);
+
+my $second = $yearly_id + 1;
+ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
+
+my $ticket2 = RT::Ticket->new(RT->SystemUser);
+$ticket2->Load($second);
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts 21 days before due: ' . $day->ymd);
+$day->add( days => 21 );
+is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due on: ' . $day->ymd);
commit a3651b0e00d001337012bd4d7fb67194cf217688
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Jul 17 08:37:51 2012 -0400
Documentation updates
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index d4473c0..569071a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -649,21 +649,145 @@ To install this module, run the following commands:
perl Makefile.PL
make
- make install
- make initdb
+ make install # May need sudo/root
+ make initdb # May need sudo/root
add RT::Extension::RepeatTicket to @Plugins in RT's etc/RT_SiteConfig.pm:
Set( @Plugins, qw(... RT::Extension::RepeatTicket) );
- Set( $RepeatTicketCoexistentNumber, 1 );
-
-C<$RepeatTicketCoexistentNumber> only works for repeats that don't rely on the
-completion of previous tickets, in which case the config will be simply
-ignored.
+ Set( $RepeatTicketCoexistentNumber, 1 ); # Optional
+ Set( $RepeatTicketLeadTime, 14 ); # Optional
add bin/rt-repeat-ticket to the daily cron job.
-=head1 Methods
+=head1 DESCRIPTION
+
+The RepeatTicket extension allows you to set up recurring tickets so
+new tickets are automatically created based on a schedule. The new tickets
+are populated with the subject and initial content of the original ticket
+in the recurrence.
+
+After you activate the plugin by adding it to your RT_SiteConfig.pm file,
+all tickets will have a Recurrence tab on the create and edit pages. To
+set up a repeating ticket, click the checkbox to "Enable Recurrence"
+and fill out the schedule for the new tickets.
+
+New tickets are created when you initially save the recurrence, if new
+tickets are needed, and when your daily cron job runs the rt-repeat-ticket
+script.
+
+=head2 C<$RepeatTicketCoexistentNumber>
+
+The C<$RepeatTicketCoexistentNumber>
+determines how many tickets can be in an active status for a
+recurrence at any time. A value of 1 means one ticket at a time can be active.
+New tickets will not be created until the current active ticket is
+resolved or set to some other inactive status. You can also set this
+value per recurrence, overriding this config value.
+The extension default is 1 ticket.
+
+=head2 C<$RepeatTicketLeadTime>
+
+The C<$RepeatTicketLeadTime> becomes the ticket Starts value and sets how far
+in advance of a ticket's Due date you want the ticket to be created. This
+essentially is how long you want to give people to work on the ticket.
+
+For example, if you create a weekly recurrence scheduled on Mondays
+and set the lead time to 7 days, each Monday a ticket will be created
+with the Starts date set to that Monday and a Due date of the following
+Monday.
+
+The value you set in RT_SiteConfig.pm becomes the system default, but you can
+set this value on each ticket as well. The extension default is 14 days.
+
+=head2 rt-repeat-ticket
+
+The rt-repeat-ticket utility evaluates all of your repeating tickets and creates
+any new tickets that are needed. With no parameters, it runs for "today" each
+day. You can also pass a --date value in the form YYYY-MM-DD to run the script
+for a specific day.
+
+ bin/rt-repeat-ticket --date 2012-07-25
+
+This can be handy if your cron job doesn't run for some reason and you want to make
+sure no repeating tickets have been missed. Just go back and run the script for
+the days you missed. You can also pass dates in the future which might be handy if
+you want to experiment with recurrences in a test environment.
+
+=head1 USAGE
+
+=head2 Initial Tickets
+
+The initial ticket you create for a recurrence stores the schedule and other
+details for the recurrence.
+If you need to change the recurrence in the future, to make it more frequent or
+less frequent or anything else, make the changes on the original ticket.
+To help you find this initial ticket, which may have been resolved long
+ago, a custom field is created on each ticket
+in the recurrence with link called "Original Ticket."
+
+When setting up the recurrence, you can use the original ticket as an actual work
+ticket. When doing this, you'll need to set the Starts and Due dates when you
+create the ticket. Scheduled tickets created subsequently will set these values
+based on the recurrence. Resolving the original ticket does not cancel the
+recurrence.
+
+=head2 Start Value
+
+You can set a Start date for a new recurrence. If you don't, it defaults to the
+day you create the recurrence.
+
+=head2 Cancelling Recurrences
+
+You can cancel or end a recurrence in two ways:
+
+=over
+
+=item *
+
+Go to the original ticket in the recurrence and uncheck the Enable Recurrence
+checkbox.
+
+=item *
+
+Set ending conditions on the recurrence with either a set number of recurrences
+or an end date.
+
+=back
+
+=head2 Recursive Recurrences
+
+Creating recurrences on recurrences isn't supported and may do strange things.
+
+=head1 FAQ
+
+=over
+
+=item I'm not seeing new recurrences. Why not?
+
+A few things to check:
+
+=over
+
+=item *
+
+Do you have rt-repeat-tickets scheduled in cron? Is it running?
+
+=item *
+
+Do you have previous tickets still in an active state? Resolve those tickets
+or increase the concurrent active tickets value.
+
+=item *
+
+Is it the right day? Remember to subtract the lead time value to determine
+the day new tickets should be created.
+
+=back
+
+=back
+
+=head1 METHODS
=head2 Run( RT::Attribute $attr, DateTime $checkday )
commit 65fa8b3b6d3e7f89e4769f61e03745c8d8daed04
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Jul 17 08:53:06 2012 -0400
Update docs and add start date test
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 569071a..15ed4e3 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -783,6 +783,13 @@ or increase the concurrent active tickets value.
Is it the right day? Remember to subtract the lead time value to determine
the day new tickets should be created.
+=item *
+
+If you set a start date and another criteria like day of the week, the new
+ticket will be created on the first time that day of the week occurs
+after the start date you set (if the start date isn't on that
+day of the week).
+
=back
=back
diff --git a/t/start_date.t b/t/start_date.t
new file mode 100644
index 0000000..8ff7f94
--- /dev/null
+++ b/t/start_date.t
@@ -0,0 +1,88 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 27;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+$m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+$m->content_contains('Enable Recurrence');
+
+diag "Create a ticket with a recurrence in the General queue.";
+my $day = DateTime->now->add( days => 14 ); # Start in two weeks
+$m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up recurring aperture maintenance',
+ 'Content' => 'Perform work on portals on Tuesday and Thursday',
+ 'repeat-lead-time' => 7,
+ 'repeat-coexistent-number' => 2,
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'weekly',
+ 'repeat-details-weekly' => 'week',
+ 'repeat-details-weekly-week' => 1,
+ 'repeat-details-weekly-weeks' => 'th',
+ 'repeat-start-date' => $day->ymd,
+ },}, 'Create');
+
+$m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+my $weekly_id = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ok($weekly_id, "Created ticket with id: $weekly_id");
+
+GetThursday($day);
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
+ 'Ran recurrence script for two weeks from now.');
+my $second = $weekly_id + 1;
+ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
+
+my $ticket2 = RT::Ticket->new(RT->SystemUser);
+$ticket2->Load($second);
+
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+$day->add( days => 7 );
+is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+
+my $tomorrow = DateTime->now->add( days => 1 );
+my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ok( $ticket1->Load($weekly_id), "Loaded ticket $weekly_id");
+ok($ticket1->SetStatus('resolved'), "Ticket $weekly_id resolved");
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $tomorrow->ymd)), 'Ran recurrence script for tomorrow.');
+
+my $third = $weekly_id + 2;
+ok( $m->goto_ticket($third), "Recurrence ticket $third created.");
+$m->text_like( qr/Set up recurring aperture maintenance/);
+
+my $ticket3 = RT::Ticket->new(RT->SystemUser);
+$ticket3->Load($third);
+GetThursday($day);
+is($ticket3->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+$day->add( days => 7 );
+is( $ticket3->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+
+my $thurs = DateTime->now;
+GetThursday($thurs);
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $thurs->ymd)), 'Ran recurrence script for next Thursday.');
+my $ticket4 = RT::Ticket->new(RT->SystemUser);
+ok(!($ticket4->Load($third + 1)), 'No fourth ticket created.');
+
+
+# Didn't want to add DateTime::Format::Natural as a dependency.
+sub GetThursday {
+ my $dt = shift;
+
+ foreach (1..7){
+ return if $dt->day_of_week == 4;
+ $dt->add( days => 1);
+ }
+}
commit 8da615264aa99d2240675936c0d663dbe2bd86d8
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Jul 17 09:32:48 2012 -0400
Add tests for on complete recurrence and update date check param
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 15ed4e3..5e9fa6a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -174,7 +174,7 @@ sub Repeat {
unless (
CheckCompleteDate(
- $checkday, $last_ticket, 'day',
+ $original_date, $last_ticket, 'day',
$content->{'repeat-details-daily-complete'}
)
)
@@ -216,7 +216,7 @@ sub Repeat {
unless (
CheckCompleteDate(
- $checkday, $last_ticket, 'week',
+ $original_date, $last_ticket, 'week',
$content->{'repeat-details-weekly-complete'}
)
)
@@ -264,7 +264,7 @@ sub Repeat {
unless (
CheckCompleteDate(
- $checkday, $last_ticket, 'month',
+ $original_date, $last_ticket, 'month',
$content->{'repeat-details-monthly-complete'}
)
)
@@ -309,7 +309,7 @@ sub Repeat {
unless (
CheckCompleteDate(
- $checkday, $last_ticket, 'year',
+ $original_date, $last_ticket, 'year',
$content->{'repeat-details-yearly-complete'}
)
)
diff --git a/t/on_complete.t b/t/on_complete.t
new file mode 100644
index 0000000..04bc090
--- /dev/null
+++ b/t/on_complete.t
@@ -0,0 +1,60 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 22;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+$m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+$m->content_contains('Enable Recurrence');
+
+diag "Create a recurrence that starts based on completion of previous ticket.";
+
+my $day = DateTime->now;
+$m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up monthly aperture maintenance',
+ 'Content' => 'Perform work on portals on the first of each month',
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'monthly',
+ 'repeat-details-monthly' => 'complete',
+ 'repeat-details-monthly-complete' => 0,
+ },}, 'Create');
+
+$m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+my $monthly_id = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ok($monthly_id, "Created ticket with id: $monthly_id");
+
+my $second = $monthly_id + 1;
+my $ticket2 = RT::Ticket->new(RT->SystemUser);
+ok( !($ticket2->Load($second)), "Ticket $second not created initially");
+
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)), 'Ran recurrence script for: ' . $day->ymd);
+ok( !($ticket2->Load($second)), "Ticket $second not created after rt-repeat-ticket");
+
+my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ok( $ticket1->Load($monthly_id), "Loaded ticket $monthly_id");
+ok($ticket1->SetStatus('resolved'), "Ticket $monthly_id resolved");
+
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)), 'Ran recurrence script for: ' . $day->ymd);
+
+ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
+
+$ticket2->Load($second);
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts 14 days before due: ' . $day->ymd);
+
+# TODO: Better define due behavior for on complete recurrence.
+#$day->add( days => 14 );
+#is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due on: ' . $day->ymd);
commit 575d4b4dbb982d9abe3306ed890af1395d6e9109
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Jul 17 11:51:20 2012 -0700
Add tests for running with end dates and fix date bug
Dates passed in run loop in rt-repeat-ticket were modified,
making the run date incorrect for subsequent runs. Clone the
run date to give each ticket evaluation the original date.
Improve debug message for date check failures.
diff --git a/bin/rt-repeat-ticket.in b/bin/rt-repeat-ticket.in
index 79c8b3d..808d59f 100755
--- a/bin/rt-repeat-ticket.in
+++ b/bin/rt-repeat-ticket.in
@@ -29,13 +29,14 @@ sub run{
$attrs->Limit( FIELD => 'Name', VALUE => 'RepeatTicketSettings' );
while ( my $attr = $attrs->Next ) {
+ my $date = $args{date}->clone;
next unless $attr->Content->{'repeat-enabled'};
next if $args{ticket} && $args{ticket} != $attr->Object->id;
next
if $args{type} && $args{type} ne $attr->Content->{'repeat-type'};
$RT::Logger->info( 'Repeating ticket ' . $attr->Object->id );
- my @ids = RT::Extension::RepeatTicket::Run( $attr, $args{date} );
+ my @ids = RT::Extension::RepeatTicket::Run( $attr, $date );
if ( @ids ) {
$RT::Logger->info(
'Repeated ticket ' . $attr->Object->id . ': ' . join ', ', @ids );
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 5e9fa6a..2ec7b92 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -123,7 +123,9 @@ sub Repeat {
);
if ( $original_date->ymd gt $date->Date ) {
- $RT::Logger->debug('Failed repeat-end-date check');
+ $RT::Logger->debug('Failed repeat-end-date check '
+ . 'running with date: ' . $original_date->ymd
+ . ' and end date: ' . $date->Date );
next;
}
}
diff --git a/t/end_conditions.t b/t/end_conditions.t
new file mode 100644
index 0000000..cae27a9
--- /dev/null
+++ b/t/end_conditions.t
@@ -0,0 +1,135 @@
+use strict;
+use warnings;
+
+use RT::Extension::RepeatTicket::Test tests => 59;
+
+use_ok('RT::Extension::RepeatTicket');
+require_ok('bin/rt-repeat-ticket');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+{
+ diag "Test ending after 3 occurences";
+ my $daily_id = run_tests($baseurl, $m);
+
+ # End after 3.
+ ok( $m->goto_ticket($daily_id), "Found ticket $daily_id.");
+ $m->follow_link_ok( {text => 'Recurrence'}, 'Loaded recurrence edit' );
+
+ $m->form_name("ModifyRecurrence");
+ $m->field('repeat-end' => 'number');
+ $m->field('repeat-end-number' => 3);
+ $m->click_button(name => 'SubmitTicket');
+ $m->text_like( qr/Recurrence updated/);
+
+ my $day = DateTime->now;
+ my $id = $daily_id;
+ for (1..2){
+ my $next_id = $id + 1;
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+
+ ok( $ticket->Load($id), "Loaded ticket $id");
+ ok($ticket->SetStatus('resolved'), "Ticket $id resolved");
+
+ $day->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
+ 'Ran recurrence script for tomorrow.');
+ ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created.");
+ $m->text_like( qr/Set up recurring aperture maintenance/);
+ $id++;
+ }
+
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ ok( $ticket->Load($id), "Loaded ticket $id" );
+ ok($ticket->SetStatus('resolved'), "Ticket $id resolved");
+
+ $day->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
+ 'Ran recurrence script for tomorrow.');
+
+ my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ ok( !($ticket1->Load($id + 1)), "Ticket " . ($id+1) . " not created" );
+}
+
+{
+ diag "Test ending by a date";
+ my $daily_id = run_tests($baseurl, $m);
+
+ # End after 3.
+ ok( $m->goto_ticket($daily_id), "Found ticket $daily_id.");
+ $m->follow_link_ok( {text => 'Recurrence'}, 'Loaded recurrence edit' );
+
+ my $set_day = DateTime->now->add( days => 3 );
+ diag "Set end date to " . $set_day->ymd;
+ $m->form_name("ModifyRecurrence");
+ $m->field('repeat-end' => 'date');
+ $m->field('repeat-end-date' => $set_day->ymd);
+ $m->click_button(name => 'SubmitTicket');
+ $m->text_like( qr/Recurrence updated/);
+
+ my $day = DateTime->now;
+ my $id = $daily_id;
+ for (1..3){
+ my $next_id = $id + 1;
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+
+ ok( $ticket->Load($id), "Loaded ticket $id");
+ ok($ticket->SetStatus('resolved'), "Ticket $id resolved");
+
+ $day->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
+ 'Ran recurrence script for ' . $day->ymd );
+ ok( $m->goto_ticket($next_id), "Recurrence ticket $next_id created.");
+ $m->text_like( qr/Set up recurring aperture maintenance/);
+ $id++;
+ }
+
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ ok( $ticket->Load($id), "Loaded ticket $id" );
+ ok($ticket->SetStatus('resolved'), "Ticket $id resolved");
+
+ $day->add( days => 1 );
+ ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
+ 'Ran recurrence script for tomorrow.');
+
+ my $ticket1 = RT::Ticket->new(RT->SystemUser);
+ ok( !($ticket1->Load($id + 1)), "Ticket " . ($id+1) . " not created" );
+}
+
+
+sub run_tests{
+ my ($baseurl, $m) = @_;
+
+ ok( $m->login( 'root', 'password' ), 'logged in' );
+
+ $m->submit_form_ok({
+ form_name => 'CreateTicketInQueue',
+ fields => {
+ 'Queue' => 'General' },
+ }, 'Click to create ticket');
+
+ $m->content_contains('Enable Recurrence');
+
+ diag "Create a ticket with a recurrence in the General queue.";
+
+ $m->submit_form_ok({
+ form_name => 'TicketCreate',
+ fields => {
+ 'Subject' => 'Set up recurring aperture maintenance',
+ 'Content' => 'Perform work on portals once per day',
+ 'repeat-enabled' => 1,
+ 'repeat-type' => 'daily',
+ 'repeat-details-daily' => 'day',
+ 'repeat-details-daily-day' => 1,
+ },}, 'Create');
+
+ $m->text_like( qr/Ticket\s(\d+)\screated in queue/);
+
+ my ($daily_id) = $m->content =~ /Ticket\s(\d+)\screated in queue/;
+ ok($daily_id, "Created ticket with id: $daily_id");
+
+ my $ticket = RT::Ticket->new(RT->SystemUser);
+ $ticket->Load($daily_id);
+
+
+ return $daily_id;
+}
commit 47d0a4c02dd9e454a5369ec12c1d503b21127bdd
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 23 09:40:13 2012 -0400
Abbreviate weekdays for better layout in right column
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 7dd5f5e..8a009a8 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -248,7 +248,7 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
</div>
<%init>
-my @week_labels = qw/Sunday Monday Tuesday Wedsenday Thursday Friday Saturday/; # loc
+my @week_labels = qw/Sun Mon Tue Wed Thu Fri Sat/; # loc
my @week_values = qw/su mo tu we th fr sa/;
my @week_number_labels = qw/First Second Third Fourth Last/; # loc
my @month_labels = qw/January February March April May June July August September October November December/; # loc
commit 2e0c03120f22be487ff62d76aafeb08d2d4466af
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Jul 23 14:05:07 2012 -0400
Updating MANIFEST and adding MANIFEST.SKIP
diff --git a/MANIFEST b/MANIFEST
index 63986b2..8f776fe 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,5 +1,6 @@
-bin/rt-repeat-ticket
+bin/rt-repeat-ticket.in
Changes
+etc/initialdata
html/Callbacks/RepeatTicket/Elements/Tabs/Privileged
html/Callbacks/RepeatTicket/Ticket/Create.html/AfterBasics
html/Callbacks/RepeatTicket/Ticket/Elements/ShowSummary/LeftColumn
@@ -15,15 +16,21 @@ inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/RTx.pm
+inc/Module/Install/RTx/Factory.pm
+inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Extension/RepeatTicket.pm
+lib/RT/Extension/RepeatTicket/Test.pm.in
Makefile.PL
MANIFEST This list of files
+MANIFEST.SKIP
META.yml
README.pod
-RT-Extension-RepeatTicket-0.01/Changes
-RT-Extension-RepeatTicket-0.01/lib/RT/Extension/RepeatTicket.pm
-RT-Extension-RepeatTicket-0.01/Makefile.PL
-RT-Extension-RepeatTicket-0.01/MANIFEST
-RT-Extension-RepeatTicket-0.01/README.pod
+t/daily.t
+t/end_conditions.t
+t/monthly.t
+t/on_complete.t
+t/start_date.t
+t/weekly.t
+t/yearly.t
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..0bc6b41
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,44 @@
+
+#!start included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+#!end included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+
+t/tmp/
+\.tagstagstags
+MYMETA\.json
+MYMETA\.yml$
+\.tar\.gz$$
+
+bin/rt-repeat-ticket$
+lib/RT/Extension/RepeatTicket/Test.pm$
commit 0d4c4b2993e14a2abbcef8d44ee986f2bee1deea
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Aug 10 14:19:09 2012 -0400
Change incorrect Regenate to Create in UI
diff --git a/META.yml b/META.yml
index 8c1dd78..9ec9ebd 100644
--- a/META.yml
+++ b/META.yml
@@ -24,4 +24,4 @@ requires:
DateTime::Event::ICal: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.01
+version: 0.02_01
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 8a009a8..0e21d62 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -78,7 +78,7 @@ size="4" value="<% $ARGSRef->{'repeat-details-daily-day'} || 1 %>" /> <&|/l&>Day
<tr>
<td>
<input name="repeat-details-daily" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-daily'} || '') eq 'complete' ? 'checked="checked"' : '' |n %>/>
- <&|/l&>Regenate new task</&><input name="repeat-details-daily-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-daily-complete'} || 1 %>" /> <&|/l&>day(s) after each task is completed</&>
+ <&|/l&>Create new task</&><input name="repeat-details-daily-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-daily-complete'} || 1 %>" /> <&|/l&>day(s) after each task is completed</&>
</td>
</tr>
</table>
@@ -117,7 +117,7 @@ size="4" value="<% $ARGSRef->{'repeat-details-weekly-week'} || 1 %>" /> <&|/l&>w
<tr>
<td colspan="5">
<input name="repeat-details-weekly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-weekly'} || '') eq 'complete' ? 'checked="checked"' : '' |n%>/>
- <&|/l&>Regenate new task</&><input name="repeat-details-weekly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-weekly-complete'} || 1 %>" /> <&|/l&>week(s) after each task is completed</&>
+ <&|/l&>Create new task</&><input name="repeat-details-weekly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-weekly-complete'} || 1 %>" /> <&|/l&>week(s) after each task is completed</&>
</td>
</tr>
</table>
@@ -153,7 +153,7 @@ size="4" value="<% $ARGSRef->{'repeat-details-weekly-week'} || 1 %>" /> <&|/l&>w
<tr>
<td>
<input name="repeat-details-monthly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-monthly'} || '') eq 'complete' ? 'checked="checked"' : '' |n %> />
- <&|/l&>Regenate new task</&><input
+ <&|/l&>Create new task</&><input
name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-monthly-complete'} || 1 %>" /> <&|/l&>month(s) after each task is completed</&>
</td>
</tr>
@@ -200,7 +200,7 @@ name="repeat-details-monthly-complete" type="text" size="4" value="<% $ARGSRef->
<tr>
<td>
<input name="repeat-details-yearly" type="radio" value="complete" <% ($ARGSRef->{'repeat-details-yearly'} || '') eq 'complete' ? 'checked="checked"' : '' |n %> />
- <&|/l&>Regenate new task</&><input name="repeat-details-yearly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-yearly-complete'} || 1 %>" /> <&|/l&>year(s) after each task is completed</&>
+ <&|/l&>Create new task</&><input name="repeat-details-yearly-complete" type="text" size="4" value="<% $ARGSRef->{'repeat-details-yearly-complete'} || 1 %>" /> <&|/l&>year(s) after each task is completed</&>
</td>
</tr>
</table>
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 2ec7b92..69192eb 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -3,7 +3,7 @@ use strict;
package RT::Extension::RepeatTicket;
-our $VERSION = "0.01";
+our $VERSION = "0.02_01";
use RT::Interface::Web;
use DateTime;
commit a485e09ee348112c56cc16887c905d6d645019c1
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Sep 27 14:56:21 2012 -0400
Fix incorrect comparison for start date
The start date comparison was previously a strict lt, so
on the actual start date, a recurring ticket would not be
created. Changed to le to include the start date.
Also fixed some incorrect notes on tests.
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 69192eb..4457aa1 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -99,7 +99,7 @@ sub Repeat {
Format => 'unknown',
Value => $content->{'repeat-start-date'},
);
- if ( $checkday->ymd lt $date->Date ) {
+ if ( $checkday->ymd le $date->Date ) {
$RT::Logger->debug('Not yet at start date' . $date->Date);
next;
}
diff --git a/t/start_date.t b/t/start_date.t
index 8ff7f94..69476e8 100644
--- a/t/start_date.t
+++ b/t/start_date.t
@@ -19,12 +19,15 @@ $m->submit_form_ok({
$m->content_contains('Enable Recurrence');
diag "Create a ticket with a recurrence in the General queue.";
+
my $day = DateTime->now->add( days => 14 ); # Start in two weeks
+diag "Repeat start date is: " . $day->ymd;
+
$m->submit_form_ok({
form_name => 'TicketCreate',
fields => {
'Subject' => 'Set up recurring aperture maintenance',
- 'Content' => 'Perform work on portals on Tuesday and Thursday',
+ 'Content' => 'Perform work on portals on Thursday',
'repeat-lead-time' => 7,
'repeat-coexistent-number' => 2,
'repeat-enabled' => 1,
@@ -42,16 +45,16 @@ ok($weekly_id, "Created ticket with id: $weekly_id");
GetThursday($day);
ok(!(RT::Repeat::Ticket::Run->run('-date=' . $day->ymd)),
- 'Ran recurrence script for two weeks from now.');
+ 'Ran recurrence script for two weeks from now: ' . $day->ymd );
my $second = $weekly_id + 1;
ok( $m->goto_ticket($second), "Recurrence ticket $second created.");
my $ticket2 = RT::Ticket->new(RT->SystemUser);
$ticket2->Load($second);
-is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+is($ticket2->StartsObj->ISO(Time => 0), $day->ymd, 'Starts in 2 weeks: ' . $day->ymd);
$day->add( days => 7 );
-is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+is( $ticket2->DueObj->ISO(Time => 0), $day->ymd, 'Due in 2 weeks + 7 days lead time: ' . $day->ymd);
my $tomorrow = DateTime->now->add( days => 1 );
my $ticket1 = RT::Ticket->new(RT->SystemUser);
@@ -66,13 +69,14 @@ $m->text_like( qr/Set up recurring aperture maintenance/);
my $ticket3 = RT::Ticket->new(RT->SystemUser);
$ticket3->Load($third);
GetThursday($day);
-is($ticket3->StartsObj->ISO(Time => 0), $day->ymd, 'Starts tomorrow: ' . $day->ymd);
+is($ticket3->StartsObj->ISO(Time => 0), $day->ymd, 'Next starts is 3 weeks out: ' . $day->ymd);
$day->add( days => 7 );
-is( $ticket3->DueObj->ISO(Time => 0), $day->ymd, 'Due in 7 days: ' . $day->ymd);
+is( $ticket3->DueObj->ISO(Time => 0), $day->ymd, 'Due in 3 weeks + 7 days lead time: ' . $day->ymd);
my $thurs = DateTime->now;
GetThursday($thurs);
-ok(!(RT::Repeat::Ticket::Run->run('-date=' . $thurs->ymd)), 'Ran recurrence script for next Thursday.');
+ok(!(RT::Repeat::Ticket::Run->run('-date=' . $thurs->ymd)),
+ 'Ran recurrence script for next Thursday: ' . $thurs->ymd );
my $ticket4 = RT::Ticket->new(RT->SystemUser);
ok(!($ticket4->Load($third + 1)), 'No fourth ticket created.');
@@ -82,7 +86,7 @@ sub GetThursday {
my $dt = shift;
foreach (1..7){
- return if $dt->day_of_week == 4;
+ return if $dt->day_of_week == 4; # It's Thursday
$dt->add( days => 1);
}
}
commit d0c64031bd35fc75d2fa7f6a1235bcfdc1d4c647
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Sep 27 15:01:58 2012 -0400
Add validation to require a weekday when weekly recurrence selected
Also preserve args passed on the ModifyRecurrence page when it
fails to save because of the missing weekday.
diff --git a/html/Ticket/Elements/EditRecurrence b/html/Ticket/Elements/EditRecurrence
index 0e21d62..8a6a063 100644
--- a/html/Ticket/Elements/EditRecurrence
+++ b/html/Ticket/Elements/EditRecurrence
@@ -258,9 +258,10 @@ if ( $Ticket ) {
if ( $repeat ) {
$ARGSRef = $repeat->Content if $repeat;
}
- else {
- $Initial = 1;
- }
+}
+
+if ( not $ARGSRef ){
+ $Initial = 1;
}
$ARGSRef->{'repeat-type'} ||= 'daily';
diff --git a/html/Ticket/ModifyRecurrence.html b/html/Ticket/ModifyRecurrence.html
index f526976..081b69c 100644
--- a/html/Ticket/ModifyRecurrence.html
+++ b/html/Ticket/ModifyRecurrence.html
@@ -6,7 +6,7 @@
<form method="post" name="ModifyRecurrence" action="ModifyRecurrence.html">
<input type="hidden" class="hidden" name="id" value="<%$TicketObj->Id%>" />
<&| /Widgets/TitleBox,title => loc('Modify recurrence for ticket # [_1]', $TicketObj->Id), class=> 'ticket-info-repeat' &>
-<& Elements/EditRecurrence, Ticket => $TicketObj &>
+<& Elements/EditRecurrence, Ticket => $TicketObj, ARGSRef => $ARGSRef &>
</&>
<& /Elements/Submit, Name => 'SubmitTicket', Label => loc('Save Changes') &>
</form>
@@ -18,6 +18,7 @@ my $TicketObj = LoadTicket($id);
my @results;
if ( $ARGS{SubmitTicket} ) {
my ( $ret, $message ) = RT::Extension::RepeatTicket::SetRepeatAttribute( $TicketObj, %ARGS );
+ $ARGSRef = \%ARGS if not $ret; # Save params on failure
push @results, $message;
}
@@ -25,4 +26,5 @@ if ( $ARGS{SubmitTicket} ) {
<%ARGS>
$id => undef
+$ARGSRef => undef
</%ARGS>
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index 4457aa1..bedc418 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -19,13 +19,18 @@ my $old_create_ticket = \&HTML::Mason::Commands::CreateTicket;
my %args = @_;
my ( $ticket, @actions ) = $old_create_ticket->(@_);
if ( $ticket && $args{'repeat-enabled'} ) {
- my ($attr) = SetRepeatAttribute(
+ my ($attr, $message) = SetRepeatAttribute(
$ticket,
'tickets' => [ $ticket->id ],
'last-ticket' => $ticket->id,
map { $_ => $args{$_} } grep { /^repeat/ } keys %args
);
- Run($attr);
+ if ( $attr ) {
+ Run($attr);
+ }
+ else {
+ push @actions, $message;
+ }
}
return ( $ticket, @actions );
};
@@ -41,6 +46,13 @@ sub SetRepeatAttribute {
%args
);
+ my ($valid, $message) = ValidateArgs(\%repeat_args);
+
+ if ( not $valid ){
+ $message = "Recurrence not updated: " . $message;
+ return (undef, $message);
+ }
+
my ($old_attr) = $ticket->Attributes->Named('RepeatTicketSettings');
my %old;
%old = %{ $old_attr->Content } if $old_attr;
@@ -57,6 +69,25 @@ sub SetRepeatAttribute {
return ( $attr, $ticket->loc('Recurrence updated') ); # loc
}
+sub ValidateArgs {
+ my $args_ref = shift;
+ my $result = 1;
+ my $message;
+
+ # If recur every X weeks is selected, a weekday is required
+ if ( $args_ref->{'repeat-type'} eq 'weekly'
+ and $args_ref->{'repeat-details-weekly-week'} ){
+
+ my $weeks = $args_ref->{'repeat-details-weekly-weeks'};
+ unless ( defined $weeks ) {
+ $message .= 'No weekday selected for weekly recurrence';
+ $result = 0;
+ }
+ }
+
+ return ( $result, $message );
+}
+
use RT::Ticket;
sub Run {
commit 4edaf29b9132b9e5b2f92294a775e1995999c813
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Sep 27 16:42:02 2012 -0400
Add transactions for changes to recurrence values
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index bedc418..b0e3b9a 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -64,11 +64,52 @@ sub SetRepeatAttribute {
Content => $content,
);
+ ProcessTransactions($ticket, \%old, \%repeat_args) if $old_attr;
+
my ($attr) = $ticket->Attributes->Named('RepeatTicketSettings');
return ( $attr, $ticket->loc('Recurrence updated') ); # loc
}
+sub ProcessTransactions {
+ my $ticket = shift;
+ my $old_ref = shift;
+ my $new_ref = shift;
+
+ foreach my $key (keys %$old_ref){
+
+ # Keys should be the same since they are coming
+ # from the same form, but just in case.
+ next unless exists $new_ref->{$key};
+
+ {
+ # We know some values will be uninitialized
+ no warnings 'uninitialized';
+
+ # temp values to avoid changing the source hashes
+ my $old = $old_ref->{$key};
+ my $new = $new_ref->{$key};
+
+ $old = join ',', @$old if ref $old eq 'ARRAY';
+ $new = join ',', @$new if ref $new eq 'ARRAY';
+
+ if ( $old ne $new ){
+
+ # Add a transaction
+ my ( $Trans, $Msg, $TransObj ) = $ticket->_NewTransaction(
+ Type => "Set",
+ Field => $key,
+ OldValue => $old,
+ NewValue => $new,
+ CommitScrips => 0,
+ ActivateScrips => 0,
+ );
+ }
+ }
+ }
+ return;
+}
+
sub ValidateArgs {
my $args_ref = shift;
my $result = 1;
commit 46ee4586b244bae8f06411736430ad08fb541eb2
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Sep 27 16:48:45 2012 -0400
Bump version
diff --git a/META.yml b/META.yml
index 9ec9ebd..8771042 100644
--- a/META.yml
+++ b/META.yml
@@ -24,4 +24,4 @@ requires:
DateTime::Event::ICal: 0
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.02_01
+version: 0.02_02
diff --git a/lib/RT/Extension/RepeatTicket.pm b/lib/RT/Extension/RepeatTicket.pm
index b0e3b9a..59d0022 100644
--- a/lib/RT/Extension/RepeatTicket.pm
+++ b/lib/RT/Extension/RepeatTicket.pm
@@ -3,7 +3,7 @@ use strict;
package RT::Extension::RepeatTicket;
-our $VERSION = "0.02_01";
+our $VERSION = "0.02_02";
use RT::Interface::Web;
use DateTime;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list