[Bps-public-commit] rt-extension-timetracking branch, master, created. 010050a4785590780083b84319fbee655c741a75
Jim Brandt
jbrandt at bestpractical.com
Tue Feb 16 14:15:32 EST 2016
The branch, master has been created
at 010050a4785590780083b84319fbee655c741a75 (commit)
- Log -----------------------------------------------------------------
commit ae74a43f10f983554474bbe118df55f85f32b46e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Nov 12 01:26:16 2013 +0800
initial import
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..cfec740
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,14 @@
+blib*
+Makefile
+Makefile.old
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+/RT-Extension-TimeTracking*
+*.bak
+*.swp
+/MYMETA.*
+/t/tmp
+/xt/tmp
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..a915524
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,23 @@
+etc/initialdata
+html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
+html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
+html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+html/Tools/MyWeek.html
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/ReadmeFromPod.pm
+inc/Module/Install/RTx.pm
+inc/Module/Install/RTx/Factory.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/RT/Extension/TimeTracking.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
+static/css/time_tracking.css
+static/js/time_tracking.js
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..9be4f2a
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,25 @@
+---
+abstract: 'RT Extension-TimeTracking Extension'
+author:
+ - 'sunnavy <sunnavy at bestpractical.com>'
+build_requires:
+ ExtUtils::MakeMaker: 6.36
+configure_requires:
+ ExtUtils::MakeMaker: 6.36
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: gplv2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: RT-Extension-TimeTracking
+no_index:
+ directory:
+ - etc
+ - html
+ - inc
+ - static
+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..0ab5646
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,9 @@
+use inc::Module::Install;
+
+
+RTx 'RT-Extension-TimeTracking';
+all_from 'lib/RT/Extension/TimeTracking.pm';
+readme_from 'lib/RT/Extension/TimeTracking.pm';
+license 'gplv2';
+
+WriteAll;
diff --git a/README b/README
new file mode 100644
index 0000000..cca1479
--- /dev/null
+++ b/README
@@ -0,0 +1,48 @@
+NAME
+ RT-Extension-TimeTracking - Time Tracking Extension
+
+INSTALLATION
+ "perl Makefile.PL"
+ "make"
+ "make install"
+ May need root permissions
+
+ "make initdb"
+ Only run this the first time you install this module.
+
+ If you run this twice, you may end up with duplicate data in your
+ database.
+
+ If you are upgrading this module, check for upgrading instructions
+ in case changes need to be made to your database.
+
+ Edit your /opt/rt4/etc/RT_SiteConfig.pm
+ Add this line:
+
+ Set(@Plugins, qw(RT::Extension::TimeTracking));
+
+ or add "RT::Extension::TimeTracking" to your existing @Plugins line.
+
+ Clear your mason cache
+ rm -rf /opt/rt4/var/mason_data/obj
+
+ Restart your webserver
+
+AUTHOR
+ sunnavy <sunnavy at bestpractical.com>
+
+BUGS
+ All bugs should be reported via email to
+ bug-RT-Extension-TimeTracking at rt.cpan.org
+ <mailto:bug-RT-Extension-TimeTracking at rt.cpan.org> or via the web at
+ rt.cpan.org
+ <http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-TimeTrack
+ ing>.
+
+LICENSE AND COPYRIGHT
+ Copyright (c) 2013, Best Practical Solutions, LLC.
+
+ This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
diff --git a/etc/initialdata b/etc/initialdata
new file mode 100644
index 0000000..a7a779c
--- /dev/null
+++ b/etc/initialdata
@@ -0,0 +1,8 @@
+ at CustomFields = (
+ {
+ Name => 'Worked Date',
+ Type => 'Date',
+ LookupType => 'RT::Queue-RT::Ticket-RT::Transaction',
+ MaxValues => 1,
+ },
+);
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
new file mode 100644
index 0000000..598ed9f
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
@@ -0,0 +1,10 @@
+<%INIT>
+return unless $Object->isa('RT::Transaction');
+return if $Object->FirstCustomFieldValue('Worked Date');
+$CustomFields->Limit( FIELD => 'Name', VALUE => 'Worked Date', OPERATOR => '!=', CASESENSITIVE => 0 );
+</%INIT>
+
+<%ARGS>
+$Object
+$CustomFields
+</%ARGS>
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged b/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
new file mode 100644
index 0000000..0352661
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
@@ -0,0 +1,9 @@
+<%init>
+Menu()->child('tools')->child(
+ 'my_week',
+ title => loc("My Week"),
+ description => loc("Tickets you worked on this week"),
+ path => '/Tools/MyWeek.html',
+ sort_order => 2.5,
+);
+</%init>
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
new file mode 100644
index 0000000..c20bcbf
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -0,0 +1,29 @@
+<%init>
+# The self service interface doesn't support updating time fields.
+return unless $session{CurrentUser}->Privileged
+ and $session{CurrentUser}->HasRight( Object => $TicketObj, Right => "ModifyTicket" );
+
+my $date_cf = RT::CustomField->new($session{CurrentUser});
+$date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
+
+</%init>
+
+<tr>
+ <td class="label"><&|/l&>Add to time worked:</&></td>
+ <td class="value">
+ <form action="<% RT->Config->Get("WebPath") %>/Ticket/Display.html" method="POST">
+ <input type="hidden" name="id" value="<% $TicketObj->id %>">
+ <& /Elements/EditCustomField, CustomField => $date_cf, Object => RT::Transaction->new( $session{'CurrentUser'} ) &>
+ <& /Elements/EditTimeValue,
+ Name => "UpdateTimeWorked",
+ Default => $ARGS{UpdateTimeWorked} || '',
+ InUnits => $ARGS{'UpdateTimeWorked-TimeUnits'} || 'minutes',
+ &>
+ <input type="submit" value="<% loc('Add time') %>">
+ </form>
+ </td>
+</tr>
+
+<%args>
+$TicketObj
+</%args>
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
new file mode 100644
index 0000000..4a7a70c
--- /dev/null
+++ b/html/Tools/MyWeek.html
@@ -0,0 +1,205 @@
+<& /Elements/Header, Title => $user && $user->id != $session{CurrentUser}->id ? loc("[_1]'s Week", $user->Name) : loc("My Week") &>
+
+<& /Elements/Tabs &>
+
+<& /Elements/ListActions, actions => \@results &>
+
+<div class="time_tracking">
+
+<form>
+% if ( $DefaultTimeUnits ) {
+<input type="hidden" value="<% $DefaultTimeUnits %>" name="DefaultTimeUnits" />
+% }
+
+% if ( $session{CurrentUser}->HasRight( Object => $RT::System, Right => 'AdminTimesheets' )) {
+<div>
+<input type="hidden" name="User" value="<% $User || '' %>" />
+<&|/l&>Go to user</&>
+<input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" />
+</div>
+% }
+
+<&|/l&>Week of(pick any day in week)</&>: <& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO') &>
+</form>
+
+% for my $day ( sort keys %week_worked ) {
+<h2><% $week_worked{$day}{date}->RFC2822(Time => 0, Timezone => 'user') %></h2>
+
+% if ( %{$week_worked{$day}{tickets}} ) {
+<table class="ticket-list collection-as-table">
+<tr class="collection-as-table">
+<th class="collection-as-table">id</th>
+<th class="collection-as-table">Subject</th>
+<th class="collection-as-table">Status</th>
+<th class="collection-as-table">Owner</th>
+<th class="collection-as-table">Time Worked</th>
+</tr>
+% my $i = 1;
+% for my $ticket_id ( sort { $a <=> $b } keys %{$week_worked{$day}{tickets}} ) {
+% my $entry = $week_worked{$day}{tickets}{$ticket_id};
+% my $ticket = $entry->{ticket};
+<tr class="<% $i++ % 2 ? 'oddline' : 'evenline' %>">
+<td class="collection-as-table">
+<a href="<% RT->Config->Get('WebPath') %>/Ticket/Display.html?id=<% $ticket->id %>"><% $ticket->id %></a>
+</td>
+<td class="collection-as-table">
+<a href="<% RT->Config->Get('WebPath') %>/Ticket/Display.html?id=<% $ticket->id %>"><% $ticket->Subject %></a>
+</td>
+<td class="collection-as-table"><% $ticket->Status %></td>
+<td class="collection-as-table"><% $ticket->OwnerObj->Name %></td>
+<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
+</tr>
+% }
+</table>
+
+<div class="time_worked">
+<span class="label"><&|/l&>Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $week_worked{$day}{time_worked} &></span>
+</div>
+% }
+
+<form method="POST">
+ <input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
+ <&|/l&>Add ticket</&>: <input name="id" type="text" size="8" />
+ <&|/l&>Time Worked</&>:
+ <& /Elements/EditTimeValue,
+ Name => "UpdateTimeWorked",
+ Default => '',
+ InUnits => $DefaultTimeUnits || 'minutes',
+ &>
+ <input type="submit" class="button" value="<% loc('Save') %>">
+</form>
+
+% }
+
+<hr />
+<div class="time_worked">
+<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
+</div>
+
+</div>
+<%INIT>
+my $user;
+my @results;
+if ( $User ) {
+ if ( $session{CurrentUser}->HasRight( Object => $RT::System, Right => 'AdminTimesheets' ) ) {
+ $user = RT::CurrentUser->new($session{CurrentUser});
+ $user->Load($User);
+ unless ( $user->id ) {
+ push @results, loc("Could not load user [_1]", $User);
+ }
+ }
+ else {
+ push @results, loc("Permission denied");
+ }
+}
+else {
+ $user = $session{CurrentUser};
+}
+
+MaybeRedirectForResults(
+ Actions => \@results,
+ Arguments => { Date => $Date, DefaultTimeUnits => $DefaultTimeUnits },
+);
+
+my $date_cf = RT::CustomField->new($user);
+$date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
+
+
+if ( defined $ARGS{'UpdateTimeWorked'} ) {
+ RT::Interface::Web::PreprocessTimeUpdates(\%ARGS);
+ my $ticket = RT::Ticket->new( $user );
+ $ticket->Load($ARGS{id});
+
+ if ( $ticket->id ) {
+ my ( $val, $msg, $txn ) = $ticket->SetTimeWorked( $ticket->TimeWorked + $ARGS{'UpdateTimeWorked'} );
+ push( @results, $msg );
+ $txn->UpdateCustomFields( %ARGS ) if $txn;
+ }
+ else {
+ push @results, loc("Could not load ticket $ARGS{id}");
+ }
+
+ MaybeRedirectForResults(
+ Actions => \@results,
+ Arguments => { Date => $Date, DefaultTimeUnits => $DefaultTimeUnits, User => $User },
+ );
+}
+
+my $date = RT::Date->new($user);
+if ($Date) {
+ $date->Set(Value => $Date, Format => 'unknown');
+} else {
+ $date->SetToNow;
+}
+$date->SetToMidnight( Timezone => 'user' );
+
+my $wday = ($date->Localtime())[6] || 7;
+my $week_start = RT::Date->new($user);
+$week_start->Set( Value => $date->Unix );
+$week_start->AddDays( -1 * $wday + 1 ) unless $wday == 1;
+
+my $week_end = RT::Date->new($user);
+$week_end->Set( Value => $date->Unix );
+$week_end->AddDays( 8 - $wday );
+
+my %week_worked;
+for my $offset ( 0 .. 6 ) {
+ my $date = RT::Date->new($user);
+ $date->Set( Value => $week_start->Unix );
+ $date->AddDays( $offset ) if $offset;
+ $week_worked{$date->ISO(Time => 0, Timezone => 'user')} = {
+ date => $date,
+ tickets => {},
+ };
+}
+
+my $txns = RT::Transactions->new($user);
+$txns->Limit(
+ FIELD => 'ObjectType',
+ VALUE => 'RT::Ticket',
+);
+
+$txns->Limit(
+ FIELD => 'Creator',
+ VALUE => $user->id,
+);
+
+$txns->Limit(
+ FIELD => 'TimeTaken',
+ VALUE => 0,
+ OPERATOR => '!=',
+);
+
+$txns->Limit(
+ FIELD => 'Created',
+ VALUE => $week_start->ISO(),
+ OPERATOR => '>=',
+);
+$txns->Limit(
+ FIELD => 'Created',
+ VALUE => $week_end->ISO(),
+ OPERATOR => '<',
+ ENTRYAGGREGATOR => 'AND',
+);
+
+my $total_time_worked = 0;
+while ( my $txn = $txns->Next ) {
+ my $ticket = $txn->Object;
+ my $worked_date = $txn->FirstCustomFieldValue('Worked Date') || $txn->CreatedObj->ISO( Time => 0, Timezone => 'user' );
+
+ next unless $week_worked{$worked_date};
+ $week_worked{$worked_date}{tickets}{$ticket->id} ||= {
+ ticket => $ticket,
+ };
+ $week_worked{$worked_date}{tickets}{$ticket->id}{time_worked} += $txn->TimeTaken;
+ $week_worked{$worked_date}{time_worked} += $txn->TimeTaken;
+ $total_time_worked += $txn->TimeTaken;
+}
+
+</%INIT>
+
+<%ARGS>
+$Date => undef
+$DefaultTimeUnits => undef
+$User => undef
+</%ARGS>
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..4ecf46b
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,470 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.005;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # This is not enforced yet, but will be some time in the next few
+ # releases once we can make sure it won't clash with custom
+ # Module::Install extensions.
+ $VERSION = '1.06';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
+
+Please invoke ${\__PACKAGE__} with:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+END_DIE
+
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
+
+Your installer $0 has a modification time in the future ($s > $t).
+
+This is known to create infinite loops in make.
+
+Please correct this, then run $0 again.
+
+END_DIE
+ }
+
+
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+Please remove all Build.PL files and only use the Makefile.PL installer.
+
+END_DIE
+
+ #-------------------------------------------------------------
+
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+
+ #-------------------------------------------------------------
+
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
+
+ local $^W;
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
+
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+
+ # Save to the singleton
+ $MAIN = $self;
+
+ return 1;
+}
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+sub new {
+ my ($class, %args) = @_;
+
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
+ # ignore the prefix on extension modules built from top level.
+ my $base_path = Cwd::abs_path($FindBin::Bin);
+ unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ delete $args{prefix};
+ }
+ return $args{_self} if $args{_self};
+
+ $args{dispatch} ||= 'Admin';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+sub load_extensions {
+ my ($self, $path, $top) = @_;
+
+ my $should_reload = 0;
+ unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
+ unshift @INC, $self->{prefix};
+ $should_reload = 1;
+ }
+
+ foreach my $rv ( $self->find_extensions($path) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+ local *FH;
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[1]) <=> _version($_[2]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..802844a
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.06';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
+}
+
+sub DESTROY {}
+
+package Module::Install::Base::FakeAdmin;
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..22167b8
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,154 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# Check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
+sub can_cc {
+ my $self = shift;
+ my @chunks = split(/ /, $Config::Config{cc}) or return;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..bee0c4f
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..7052f36
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,418 @@
+#line 1
+package Module::Install::Makefile;
+
+use strict 'vars';
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ local $ENV{PERL_MM_USE_DEFAULT} = 1;
+ goto &ExtUtils::MakeMaker::prompt;
+ } else {
+ goto &ExtUtils::MakeMaker::prompt;
+ }
+}
+
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
+sub makemaker_args {
+ my ($self, %new_args) = @_;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
+ return $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = shift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub _wanted_t {
+}
+
+sub tests_recursive {
+ my $self = shift;
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
+ require File::Find;
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ } else {
+ # Allow legacy-compatibility with 5.005 by depending on the
+ # most recent EU:MM that supported 5.005.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ if ( $self->tests ) {
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
+ }
+ if ( $] >= 5.005 ) {
+ $args->{ABSTRACT} = $self->abstract;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
+ }
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ if ( $self->makemaker(6.17) and $self->sign ) {
+ $args->{SIGN} = 1;
+ }
+ unless ( $self->is_admin ) {
+ delete $args->{SIGN};
+ }
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
+
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
+ if ($self->bundles) {
+ my %processed;
+ foreach my $bundle (@{ $self->bundles }) {
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
+ }
+ }
+
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
+ if ( my $perl_version = $self->perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
+ }
+
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
+
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
+
+ my $user_preop = delete $args{dist}->{PREOP};
+ if ( my $preop = $self->admin->preop($user_preop) ) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
+ my $makefile = do { local $/; <MAKEFILE> };
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..58430f3
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,722 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
+ }
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
+ return 1;
+}
+
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
+sub perl_version {
+ my $self = shift;
+ return $self->{values}->{perl_version} unless @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the really old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ $self->{values}{all_from} = $file;
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless @{$self->author || []};
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+sub version_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
+}
+
+sub abstract_from {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub _extract_perl_version {
+ if (
+ $_[0] =~ m/
+ ^\s*
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ my $perl_version = $1;
+ $perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
+ $self->perl_version($perl_version);
+ } else {
+ warn "Cannot determine perl version info from $_[0]\n";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
+ $self->author($author);
+ } else {
+ warn "Cannot determine author info from $_[0]\n";
+ }
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
+ }
+ }
+ return '';
+}
+
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
+}
+
+sub _extract_bugtracker {
+ my @links = $_[0] =~ m#L<(
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than one bugtracker link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..ac04c79
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,219 @@
+#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.32';
+
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+my @DIRS = qw(etc lib html static 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::LocalStaticPath ||= $RT::StaticPath;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
+ }
+
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ }
+
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
+
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
+ File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ my %has_etc;
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
+ $has_etc{schema}++;
+ }
+ if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
+ $has_etc{acl}++;
+ }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+ if ( -d 'etc/upgrade/' ) { $has_etc{upgrade}++; }
+
+ $self->postamble("$postamble\n");
+ unless ( $subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+ }
+
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ print "For first-time installation, type 'make initdb'.\n";
+ my $initdb = '';
+ $initdb .= <<"." if $has_etc{schema};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
+.
+ $self->postamble("initdb ::\n$initdb\n");
+ $self->postamble("initialize-database ::\n$initdb\n");
+ if ($has_etc{upgrade}) {
+ print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
+ my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+ $self->postamble("upgrade-database ::\n$upgradedb\n");
+ $self->postamble("upgradedb ::\n$upgradedb\n");
+ }
+ }
+}
+
+# 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 336
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
new file mode 100644
index 0000000..6776688
--- /dev/null
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -0,0 +1,53 @@
+#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, $name, $version) = @_;
+
+ 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();
+
+ require RT::System;
+
+ 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,
+ ($action eq 'upgrade' ? () : ("--datadir" => "etc")),
+ (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
+ "--dba" => $RT::DatabaseAdmin || $RT::DatabaseUser,
+ "--prompt-for-dba-password" => '',
+ (RT::System->can('AddUpgradeHistory') ? ("--package" => $name, "--ext-version" => $version) : ()),
+ );
+ # If we're upgrading against an RT which isn't at least 4.2 (has
+ # AddUpgradeHistory) then pass --package. Upgrades against later RT
+ # releases will pick up --package from AddUpgradeHistory.
+ if ($action eq 'upgrade' and
+ not RT::System->can('AddUpgradeHistory')) {
+ push @args, "--package" => $name;
+ }
+
+ print "$^X @args\n";
+ (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+1;
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
new file mode 100644
index 0000000..6a80818
--- /dev/null
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -0,0 +1,138 @@
+#line 1
+package Module::Install::ReadmeFromPod;
+
+use 5.006;
+use strict;
+use warnings;
+use base qw(Module::Install::Base);
+use vars qw($VERSION);
+
+$VERSION = '0.20';
+
+sub readme_from {
+ my $self = shift;
+ return unless $self->is_admin;
+
+ # Input file
+ my $in_file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
+
+ # Get optional arguments
+ my ($clean, $format, $out_file, $options);
+ my $args = shift;
+ if ( ref $args ) {
+ # Arguments are in a hashref
+ if ( ref($args) ne 'HASH' ) {
+ die "Expected a hashref but got a ".ref($args)."\n";
+ } else {
+ $clean = $args->{'clean'};
+ $format = $args->{'format'};
+ $out_file = $args->{'output_file'};
+ $options = $args->{'options'};
+ }
+ } else {
+ # Arguments are in a list
+ $clean = $args;
+ $format = shift;
+ $out_file = shift;
+ $options = \@_;
+ }
+
+ # Default values;
+ $clean ||= 0;
+ $format ||= 'txt';
+
+ # Generate README
+ print "readme_from $in_file to $format\n";
+ if ($format =~ m/te?xt/) {
+ $out_file = $self->_readme_txt($in_file, $out_file, $options);
+ } elsif ($format =~ m/html?/) {
+ $out_file = $self->_readme_htm($in_file, $out_file, $options);
+ } elsif ($format eq 'man') {
+ $out_file = $self->_readme_man($in_file, $out_file, $options);
+ } elsif ($format eq 'pdf') {
+ $out_file = $self->_readme_pdf($in_file, $out_file, $options);
+ }
+
+ if ($clean) {
+ $self->clean_files($out_file);
+ }
+
+ return 1;
+}
+
+
+sub _readme_txt {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README';
+ require Pod::Text;
+ my $parser = Pod::Text->new( @$options );
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ $parser->output_fh( *$out_fh );
+ $parser->parse_file( $in_file );
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _readme_htm {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.htm';
+ require Pod::Html;
+ Pod::Html::pod2html(
+ "--infile=$in_file",
+ "--outfile=$out_file",
+ @$options,
+ );
+ # Remove temporary files if needed
+ for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
+ if (-e $file) {
+ unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
+ }
+ }
+ return $out_file;
+}
+
+
+sub _readme_man {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.1';
+ require Pod::Man;
+ my $parser = Pod::Man->new( @$options );
+ $parser->parse_from_file($in_file, $out_file);
+ return $out_file;
+}
+
+
+sub _readme_pdf {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.pdf';
+ eval { require App::pod2pdf; }
+ or die "Could not generate $out_file because pod2pdf could not be found\n";
+ my $parser = App::pod2pdf->new( @$options );
+ $parser->parse_from_file($in_file);
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ select $out_fh;
+ $parser->output;
+ select STDOUT;
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
+}
+
+'Readme!';
+
+__END__
+
+#line 254
+
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..eeaa3fe
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..85d8018
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,63 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
+ }
+
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
+}
+
+1;
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
new file mode 100644
index 0000000..875c15c
--- /dev/null
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -0,0 +1,76 @@
+use strict;
+use warnings;
+package RT::Extension::TimeTracking;
+
+our $VERSION = '0.01';
+
+RT->AddStyleSheets("time_tracking.css");
+RT->AddJavaScript("time_tracking.js");
+
+RT::System->AddRight( Admin => AdminTimesheets => 'Add time worked for other users' );
+
+=head1 NAME
+
+RT-Extension-TimeTracking - Time Tracking Extension
+
+=head1 INSTALLATION
+
+=over
+
+=item C<perl Makefile.PL>
+
+=item C<make>
+
+=item C<make install>
+
+May need root permissions
+
+=item C<make initdb>
+
+Only run this the first time you install this module.
+
+If you run this twice, you may end up with duplicate data
+in your database.
+
+If you are upgrading this module, check for upgrading instructions
+in case changes need to be made to your database.
+
+=item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
+
+Add this line:
+
+ Set(@Plugins, qw(RT::Extension::TimeTracking));
+
+or add C<RT::Extension::TimeTracking> to your existing C<@Plugins> line.
+
+=item Clear your mason cache
+
+ rm -rf /opt/rt4/var/mason_data/obj
+
+=item Restart your webserver
+
+=back
+
+=head1 AUTHOR
+
+sunnavy <sunnavy at bestpractical.com>
+
+=head1 BUGS
+
+All bugs should be reported via email to
+L<bug-RT-Extension-TimeTracking at rt.cpan.org|mailto:bug-RT-Extension-TimeTracking at rt.cpan.org>
+or via the web at
+L<rt.cpan.org|http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-TimeTracking>.
+
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2013, Best Practical Solutions, LLC.
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
+=cut
+
+1;
diff --git a/static/css/time_tracking.css b/static/css/time_tracking.css
new file mode 100644
index 0000000..3eb85f1
--- /dev/null
+++ b/static/css/time_tracking.css
@@ -0,0 +1,9 @@
+div.time_tracking div.time_worked {
+ clear: both;
+ text-align: right;
+ margin-right: 20px;
+}
+
+div.time_tracking h2 {
+ margin-top: 30px;
+}
diff --git a/static/js/time_tracking.js b/static/js/time_tracking.js
new file mode 100644
index 0000000..9db52d6
--- /dev/null
+++ b/static/js/time_tracking.js
@@ -0,0 +1,9 @@
+jQuery( function() {
+ jQuery('div.time_tracking input[name=Date], div.time_tracking input[name=User]').change( function() {
+ jQuery(this).closest('form').submit();
+ });
+
+ jQuery("div.time_tracking input[name=UserString]").on("autocompleteselect", function( event, ui ) {
+ jQuery(this).closest('form').find('input[name=User]').val(ui.item.id).change();
+ });
+});
commit 39b2bd44ebd6665ef96f9c56f3bf8274fa5e3a3e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Nov 12 22:01:38 2013 +0800
RT patch to make 'Worked Date' txn cf actually work
RT ignores txn cfs if there is no update message(reply or comment) by default.
this patch makes sure "Worked Date" get recorded.
diff --git a/MANIFEST b/MANIFEST
index a915524..35dc5e9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
etc/initialdata
html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
diff --git a/README b/README
index cca1479..5ecd72b 100644
--- a/README
+++ b/README
@@ -16,6 +16,9 @@ INSTALLATION
If you are upgrading this module, check for upgrading instructions
in case changes need to be made to your database.
+ patch RT
+ patch -p1 -d /path/to/rt < etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
+
Edit your /opt/rt4/etc/RT_SiteConfig.pm
Add this line:
diff --git a/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch b/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
new file mode 100644
index 0000000..3d1262d
--- /dev/null
+++ b/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
@@ -0,0 +1,68 @@
+From 30935bb85e63a168b31559d7d2e225134a694a15 Mon Sep 17 00:00:00 2001
+From: sunnavy <sunnavy at bestpractical.com>
+Date: Tue, 12 Nov 2013 21:49:46 +0800
+Subject: [PATCH] handle txn cfs on ticket creation and updates(with
+ UpdateTimeWorked but no content)
+
+---
+ lib/RT/Interface/Web.pm | 16 ++++++++++++++--
+ lib/RT/Ticket.pm | 2 +-
+ 2 files changed, 15 insertions(+), 3 deletions(-)
+
+diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
+index 2dd0fd1..4a73d3b 100644
+--- a/lib/RT/Interface/Web.pm
++++ b/lib/RT/Interface/Web.pm
+@@ -2760,7 +2760,6 @@ sub ProcessTicketBasics {
+ FinalPriority
+ Priority
+ TimeEstimated
+- TimeWorked
+ TimeLeft
+ Type
+ Status
+@@ -2789,6 +2788,12 @@ sub ProcessTicketBasics {
+ ARGSRef => $ARGSRef,
+ );
+
++ if ( defined $ARGSRef->{'TimeWorked'} ) {
++ my ( $val, $msg, $txn ) = $TicketObj->SetTimeWorked( $ARGSRef->{'TimeWorked'} );
++ push( @results, $msg );
++ $txn->UpdateCustomFields( %$ARGSRef) if $txn;
++ }
++
+ # We special case owner changing, so we can use ForceOwnerChange
+ if ( $ARGSRef->{'Owner'}
+ && $ARGSRef->{'Owner'} !~ /\D/
+@@ -3169,7 +3174,14 @@ sub ProcessObjectCustomFieldUpdatesForCreate {
+ );
+ }
+
+- $parsed{"CustomField-$cfid"} = \@values if @values;
++ if (@values) {
++ if ( $class eq 'RT::Transaction' ) {
++ $parsed{"Object-RT::Transaction--CustomField-$cfid"} = \@values;
++ }
++ else {
++ $parsed{"CustomField-$cfid"} = \@values if @values;
++ }
++ }
+ }
+ }
+
+diff --git a/lib/RT/Ticket.pm b/lib/RT/Ticket.pm
+index 80af7f5..d4e2055 100644
+--- a/lib/RT/Ticket.pm
++++ b/lib/RT/Ticket.pm
+@@ -2671,7 +2671,7 @@ sub _Set {
+ # just made the ticket unreadable to us
+ $trans->{ _object_is_readable } = 1;
+
+- return ( $ret, scalar $trans->BriefDescription );
++ return ( $ret, scalar $trans->BriefDescription, $trans );
+ }
+
+
+--
+1.8.4.1
+
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 875c15c..4a21079 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -35,6 +35,10 @@ in your database.
If you are upgrading this module, check for upgrading instructions
in case changes need to be made to your database.
+=item patch RT
+
+ patch -p1 -d /path/to/rt < etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
+
=item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
Add this line:
commit 4a065f0a230273dda35c25ad70422bfcc2c036b2
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 20:52:57 2013 +0800
autocomplete ticket and tweak "total" label for each week day
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 4a7a70c..68e6f3c 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -53,13 +53,13 @@
</table>
<div class="time_worked">
-<span class="label"><&|/l&>Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $week_worked{$day}{time_worked} &></span>
+<span class="label"><&|/l&><% $week_worked{$day}{week_name} %> Total</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $week_worked{$day}{time_worked} &></span>
</div>
% }
<form method="POST">
<input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
- <&|/l&>Add ticket</&>: <input name="id" type="text" size="8" />
+ <&|/l&>Add ticket</&>: <input name="id" type="text" size="8" data-autocomplete="Tickets" />
<&|/l&>Time Worked</&>:
<& /Elements/EditTimeValue,
Name => "UpdateTimeWorked",
@@ -143,12 +143,14 @@ $week_end->Set( Value => $date->Unix );
$week_end->AddDays( 8 - $wday );
my %week_worked;
+my @week_name = qw/Monday Tuesday Wednesday Thursday Friday Saturday Sunday/;
for my $offset ( 0 .. 6 ) {
my $date = RT::Date->new($user);
$date->Set( Value => $week_start->Unix );
$date->AddDays( $offset ) if $offset;
$week_worked{$date->ISO(Time => 0, Timezone => 'user')} = {
date => $date,
+ week_name => $week_name[$offset],
tickets => {},
};
}
commit e602f8ef8eedfb6794c7f559798d9a12140e6bce
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 20:54:25 2013 +0800
"Return to My Week" page menu
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged b/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
index 0352661..3aeeb1f 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
+++ b/html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
@@ -6,4 +6,14 @@ Menu()->child('tools')->child(
path => '/Tools/MyWeek.html',
sort_order => 2.5,
);
+
+my $request_path = $HTML::Mason::Commands::r->path_info;
+$request_path =~ s!/{2,}!/!g;
+if ( $request_path =~ m{^/Tools/MyWeek.html} && $DECODED_ARGS->{'User'} && $DECODED_ARGS->{'User'} != $session{CurrentUser}->id ) {
+ PageMenu()->child('my_week',
+ title => loc('Return to My Week'),
+ description => loc('Return to My Week'),
+ path => '/Tools/MyWeek.html',
+ );
+}
</%init>
commit b93e334818d892389b4c2baf46662e97ef13e40f
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 20:55:31 2013 +0800
to reduce width
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
index c20bcbf..56d19c9 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -19,7 +19,7 @@ $date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket
Default => $ARGS{UpdateTimeWorked} || '',
InUnits => $ARGS{'UpdateTimeWorked-TimeUnits'} || 'minutes',
&>
- <input type="submit" value="<% loc('Add time') %>">
+ <input type="submit" value="<% loc('Add') %>">
</form>
</td>
</tr>
commit b085e6d6a2f5e67a61bbccb9b93edaf4734db642
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 23:09:04 2013 +0800
show activities happened in the week
so users can easily find what they did.
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 68e6f3c..36fa9ab 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -76,6 +76,15 @@
<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
</div>
+<&| /Widgets/TitleBox, title => loc('Activities') &>
+<& /Elements/CollectionList,
+ OrderBy => 'id',
+ Order => 'ASC',
+ Format => $activity_format,
+ Collection => $activity_tickets,
+&>
+</&>
+
</div>
<%INIT>
my $user;
@@ -198,6 +207,24 @@ while ( my $txn = $txns->Next ) {
$total_time_worked += $txn->TimeTaken;
}
+my $activity_txns = RT::Transactions->new($user);
+$txns->Limit( FIELD => 'Creator', VALUE => $user->id );
+$activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
+$activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $week_start->ISO );
+$activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $week_end->ISO, ENTRYAGGREGATOR => 'AND' );
+$activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
+
+my @ticket_ids;
+while ( my $transaction = $activity_txns->Next ) {
+ push @ticket_ids, $transaction->ObjectId;
+}
+my $activity_tickets = RT::Tickets->new( $user );
+$activity_tickets->FromSQL( join ' OR ', map { "id = $_" } @ticket_ids );
+
+my $activity_format =
+ q{'<a href="__WebPath__/Ticket/Display.html?id=__id__">__id__</a>/TITLE:id/ALIGN:Left'}.
+ q{,'<a href="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a>/TITLE:Subject'}.
+ q{,__QueueName__,__OwnerName__,__LastUpdatedBy__,__DueRelative__,__LastUpdatedRelative__};
</%INIT>
<%ARGS>
commit fb3cc26fb072b2e3b2e16aab9ac80f5fa99368b7
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 23:34:06 2013 +0800
full date range support for txn cf "Worked Date"
now we do a more thorough search so "Worked Date" can really be any date.
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 36fa9ab..7afc221 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -196,8 +196,50 @@ $txns->Limit(
my $total_time_worked = 0;
while ( my $txn = $txns->Next ) {
my $ticket = $txn->Object;
- my $worked_date = $txn->FirstCustomFieldValue('Worked Date') || $txn->CreatedObj->ISO( Time => 0, Timezone => 'user' );
-
+ next if $txn->FirstCustomFieldValue('Worked Date'); # we handle this in the next part
+ my $worked_date = $txn->CreatedObj->ISO( Time => 0, Timezone => 'user' );
+ next unless $week_worked{$worked_date};
+ $week_worked{$worked_date}{tickets}{$ticket->id} ||= {
+ ticket => $ticket,
+ };
+ $week_worked{$worked_date}{tickets}{$ticket->id}{time_worked} += $txn->TimeTaken;
+ $week_worked{$worked_date}{time_worked} += $txn->TimeTaken;
+ $total_time_worked += $txn->TimeTaken;
+}
+
+$txns = RT::Transactions->new($user);
+$txns->Limit(
+ FIELD => 'ObjectType',
+ VALUE => 'RT::Ticket',
+);
+
+$txns->Limit(
+ FIELD => 'Creator',
+ VALUE => $user->id,
+);
+
+$txns->Limit(
+ FIELD => 'TimeTaken',
+ VALUE => 0,
+ OPERATOR => '!=',
+);
+
+my $cf = RT::CustomField->new($user);
+$cf->Load('Worked Date');
+my $cf_alias = $txns->Join(
+ ALIAS1 => 'main',
+ FIELD1 => 'id',
+ TABLE2 => 'ObjectCustomFieldValues',
+ FIELD2 => 'ObjectId'
+);
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'CustomField', VALUE => $cf->id );
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'ObjectType', VALUE => 'RT::Transaction' );
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_start->ISO, OPERATOR => '>=' );
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_end->ISO, OPERATOR => '<', ENTRYAGGREGATOR => 'AND', );
+
+while ( my $txn = $txns->Next ) {
+ my $ticket = $txn->Object;
+ my $worked_date = $txn->FirstCustomFieldValue('Worked Date');
next unless $week_worked{$worked_date};
$week_worked{$worked_date}{tickets}{$ticket->id} ||= {
ticket => $ticket,
commit e820cca21c6db1cb817729f0a84b82e83e888caa
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Nov 29 23:42:37 2013 +0800
loc table headers
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 7afc221..1ed070e 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -28,11 +28,11 @@
% if ( %{$week_worked{$day}{tickets}} ) {
<table class="ticket-list collection-as-table">
<tr class="collection-as-table">
-<th class="collection-as-table">id</th>
-<th class="collection-as-table">Subject</th>
-<th class="collection-as-table">Status</th>
-<th class="collection-as-table">Owner</th>
-<th class="collection-as-table">Time Worked</th>
+<th class="collection-as-table"><&|/l&>id</&></th>
+<th class="collection-as-table"><&|/l&>Subject</&></th>
+<th class="collection-as-table"><&|/l&>Status</&></th>
+<th class="collection-as-table"><&|/l&>Owner</&></th>
+<th class="collection-as-table"><&|/l&>Time Worked</&></th>
</tr>
% my $i = 1;
% for my $ticket_id ( sort { $a <=> $b } keys %{$week_worked{$day}{tickets}} ) {
commit 6edbf1954bfa72e3250943ee934b0e0870aa2cbb
Author: sunnavy <sunnavy at bestpractical.com>
Date: Sat Nov 30 00:07:07 2013 +0800
add "Add" column make the "Add Time" more handy
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 1ed070e..d354cb7 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -33,6 +33,7 @@
<th class="collection-as-table"><&|/l&>Status</&></th>
<th class="collection-as-table"><&|/l&>Owner</&></th>
<th class="collection-as-table"><&|/l&>Time Worked</&></th>
+<th class="collection-as-table"><&|/l&>Add</&></th>
</tr>
% my $i = 1;
% for my $ticket_id ( sort { $a <=> $b } keys %{$week_worked{$day}{tickets}} ) {
@@ -48,6 +49,19 @@
<td class="collection-as-table"><% $ticket->Status %></td>
<td class="collection-as-table"><% $ticket->OwnerObj->Name %></td>
<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
+<td class="collection-as-table">
+<form method="POST">
+ <input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
+ <input name="id" type="hidden" value=<% $ticket->id %> />
+ <& /Elements/EditTimeValue,
+ Name => "UpdateTimeWorked",
+ Default => '',
+ InUnits => $DefaultTimeUnits || 'minutes',
+ &>
+ <input type="submit" class="button" value="<% loc('Save') %>">
+</form>
+
+</td>
</tr>
% }
</table>
commit 81a580eba6401cfe58f6b7f78eb205802fb46f9b
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Dec 2 16:33:47 2013 -0500
Update Add Time display to squeeze it to one line in Basics
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
index 56d19c9..121612a 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -6,14 +6,31 @@ return unless $session{CurrentUser}->Privileged
my $date_cf = RT::CustomField->new($session{CurrentUser});
$date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
-</%init>
+# The Mason code below calls directly to SelectDate to avoid printing the
+# parenthesized date and save some space. Build the CF name normally
+# built in EditCustomField and EditCustomFieldDate.
+my $cf_name = 'Object-RT::Transaction--CustomField-'
+ . $date_cf->Id . '-Values';
+
+# Default to today and also signal that the field is a date field.
+my $today = RT::Date->new($session{CurrentUser});
+$today->SetToNow();
+# Escape : so id declaration is parsed properly
+my $cf_style = $cf_name =~ s/:/\\:/gr;
+
+</%init>
+<style type="text/css">
+input#<% $cf_style %> {
+ width: 85px;
+}
+</style>
<tr>
- <td class="label"><&|/l&>Add to time worked:</&></td>
+ <td class="label"><&|/l&>Add to time</&><br /><&|/l&>worked:</&></td>
<td class="value">
<form action="<% RT->Config->Get("WebPath") %>/Ticket/Display.html" method="POST">
<input type="hidden" name="id" value="<% $TicketObj->id %>">
- <& /Elements/EditCustomField, CustomField => $date_cf, Object => RT::Transaction->new( $session{'CurrentUser'} ) &>
+ <& /Elements/SelectDate, Name => "$cf_name", current => 0, ShowTime => 0, Default => $today->Date &>
<& /Elements/EditTimeValue,
Name => "UpdateTimeWorked",
Default => $ARGS{UpdateTimeWorked} || '',
commit 30cf591ee454a01f2d659b7a91849c6775a2bad9
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Dec 2 16:34:55 2013 -0500
Apply style and table formatting to user and date options
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index d354cb7..46765d8 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -10,16 +10,20 @@
% if ( $DefaultTimeUnits ) {
<input type="hidden" value="<% $DefaultTimeUnits %>" name="DefaultTimeUnits" />
% }
-
+<table>
% if ( $session{CurrentUser}->HasRight( Object => $RT::System, Right => 'AdminTimesheets' )) {
<div>
+<tr><td class="label">
<input type="hidden" name="User" value="<% $User || '' %>" />
-<&|/l&>Go to user</&>
-<input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" />
+<&|/l&>Go to user</&>:</td>
+<td><input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" /></td>
+</tr>
</div>
% }
-
-<&|/l&>Week of(pick any day in week)</&>: <& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO') &>
+<tr><td class="label">
+<&|/l&>Week of (pick any day in week)</&>:</td>
+<td><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO') &></td></tr>
+</table>
</form>
% for my $day ( sort keys %week_worked ) {
commit 9b041b3d6bbe43fcf99f5665798d9781e25b5012
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Dec 3 20:28:15 2013 +0800
actor cf to record who _actually_ made the change
diff --git a/etc/initialdata b/etc/initialdata
index a7a779c..efd8c57 100644
--- a/etc/initialdata
+++ b/etc/initialdata
@@ -5,4 +5,10 @@
LookupType => 'RT::Queue-RT::Ticket-RT::Transaction',
MaxValues => 1,
},
+ {
+ Name => 'Actor',
+ Type => 'FreeformSingle',
+ LookupType => 'RT::Queue-RT::Ticket-RT::Transaction',
+ MaxValues => 1,
+ },
);
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
index 598ed9f..0ed4e6b 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
+++ b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
@@ -1,7 +1,11 @@
<%INIT>
return unless $Object->isa('RT::Transaction');
-return if $Object->FirstCustomFieldValue('Worked Date');
-$CustomFields->Limit( FIELD => 'Name', VALUE => 'Worked Date', OPERATOR => '!=', CASESENSITIVE => 0 );
+if ( !$Object->FirstCustomFieldValue('Worked Date') ) {
+ $CustomFields->Limit( FIELD => 'Name', VALUE => 'Worked Date', OPERATOR => '!=', CASESENSITIVE => 0 );
+}
+if ( !$Object->FirstCustomFieldValue('Actor') ) {
+ $CustomFields->Limit( FIELD => 'Name', VALUE => 'Actor', OPERATOR => '!=', CASESENSITIVE => 0, ENTRYAGGREGATOR => 'AND' );
+}
</%INIT>
<%ARGS>
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/ShowComponentName b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/ShowComponentName
new file mode 100644
index 0000000..13589ae
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/ShowComponentName
@@ -0,0 +1,9 @@
+<%INIT>
+$$Name = 'ShowCustomFieldActor' if $CustomField->Name eq 'Actor' && $CustomField->LookupType eq 'RT::Queue-RT::Ticket-RT::Transaction';
+</%INIT>
+
+<%ARGS>
+$Object
+$CustomField
+$Name
+</%ARGS>
diff --git a/html/Elements/ShowCustomFieldActor b/html/Elements/ShowCustomFieldActor
new file mode 100644
index 0000000..650ab04
--- /dev/null
+++ b/html/Elements/ShowCustomFieldActor
@@ -0,0 +1,9 @@
+<% $actor->Name |n%>
+<%INIT>
+my $actor = RT::User->new($session{CurrentUser});
+$actor->Load($Object->Content);
+</%INIT>
+
+<%ARGS>
+$Object
+</%ARGS>
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 46765d8..09a6957 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -56,6 +56,9 @@
<td class="collection-as-table">
<form method="POST">
<input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
+% if ( $user->id != $session{CurrentUser}->id ) {
+ <input type="hidden" value="<% $session{CurrentUser}->id %>" name="Object-RT::Transaction--CustomField-<% $actor_cf->id %>-Values" />
+% }
<input name="id" type="hidden" value=<% $ticket->id %> />
<& /Elements/EditTimeValue,
Name => "UpdateTimeWorked",
@@ -77,6 +80,9 @@
<form method="POST">
<input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
+% if ( $user->id != $session{CurrentUser}->id ) {
+ <input type="hidden" value="<% $session{CurrentUser}->id %>" name="Object-RT::Transaction--CustomField-<% $actor_cf->id %>-Values" />
+% }
<&|/l&>Add ticket</&>: <input name="id" type="text" size="8" data-autocomplete="Tickets" />
<&|/l&>Time Worked</&>:
<& /Elements/EditTimeValue,
@@ -131,6 +137,8 @@ MaybeRedirectForResults(
my $date_cf = RT::CustomField->new($user);
$date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
+my $actor_cf = RT::CustomField->new($user);
+$actor_cf->LoadByName( Name => 'Actor', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
if ( defined $ARGS{'UpdateTimeWorked'} ) {
RT::Interface::Web::PreprocessTimeUpdates(\%ARGS);
commit 253b404878fd43a4dc74689be4c58f930d84b35a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Dec 3 22:10:14 2013 +0800
show activity for each week day instead
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 09a6957..055fcab 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -93,22 +93,22 @@
<input type="submit" class="button" value="<% loc('Save') %>">
</form>
-% }
-
-<hr />
-<div class="time_worked">
-<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
-</div>
-
<&| /Widgets/TitleBox, title => loc('Activities') &>
<& /Elements/CollectionList,
OrderBy => 'id',
Order => 'ASC',
Format => $activity_format,
- Collection => $activity_tickets,
+ Collection => $week_worked{$day}{activity_tickets},
&>
</&>
+% }
+
+<hr />
+<div class="time_worked">
+<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
+</div>
+
</div>
<%INIT>
my $user;
@@ -275,24 +275,33 @@ while ( my $txn = $txns->Next ) {
$total_time_worked += $txn->TimeTaken;
}
-my $activity_txns = RT::Transactions->new($user);
-$txns->Limit( FIELD => 'Creator', VALUE => $user->id );
-$activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
-$activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $week_start->ISO );
-$activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $week_end->ISO, ENTRYAGGREGATOR => 'AND' );
-$activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
-
-my @ticket_ids;
-while ( my $transaction = $activity_txns->Next ) {
- push @ticket_ids, $transaction->ObjectId;
-}
-my $activity_tickets = RT::Tickets->new( $user );
-$activity_tickets->FromSQL( join ' OR ', map { "id = $_" } @ticket_ids );
-
my $activity_format =
q{'<a href="__WebPath__/Ticket/Display.html?id=__id__">__id__</a>/TITLE:id/ALIGN:Left'}.
q{,'<a href="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a>/TITLE:Subject'}.
q{,__QueueName__,__OwnerName__,__LastUpdatedBy__,__DueRelative__,__LastUpdatedRelative__};
+
+for my $day ( keys %week_worked ) {
+ my $start_date = $week_worked{$day}{date};
+ my $end_date = RT::Date->new($user);
+ $end_date->Set( Value => $start_date->Unix );
+ $end_date->AddDays(1);
+
+ my $activity_txns = RT::Transactions->new($user);
+
+ $txns->Limit( FIELD => 'Creator', VALUE => $user->id );
+ $activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
+ $activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $start_date->ISO );
+ $activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $end_date->ISO, ENTRYAGGREGATOR => 'AND' );
+ $activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
+ my @ticket_ids;
+ while ( my $transaction = $activity_txns->Next ) {
+ push @ticket_ids, $transaction->ObjectId;
+ }
+ my $activity_tickets = RT::Tickets->new( $user );
+ $activity_tickets->FromSQL( join ' OR ', map { "id = $_" } @ticket_ids );
+ $week_worked{$day}{activity_tickets} = $activity_tickets;
+}
+
</%INIT>
<%ARGS>
commit 9fa6cfc418fe05de9c69c8fdd2a74e226dc18ffc
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Dec 3 22:13:22 2013 +0800
limit activity to _real_ ones(e.g. create/comment/correspond)
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 055fcab..bf63bf5 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -292,6 +292,9 @@ for my $day ( keys %week_worked ) {
$activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
$activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $start_date->ISO );
$activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $end_date->ISO, ENTRYAGGREGATOR => 'AND' );
+ $activity_txns->Limit( FIELD => 'Type', VALUE => 'Create' );
+ $activity_txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
+ $activity_txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
$activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
my @ticket_ids;
while ( my $transaction = $activity_txns->Next ) {
commit 08b1c3a976cc9ee688f7ee74c8386df7b056da64
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Dec 3 22:15:40 2013 +0800
ignore time part for "Worked Date" cf since it's just a _date_
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index bf63bf5..01ae915 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -260,8 +260,8 @@ my $cf_alias = $txns->Join(
);
$txns->Limit( ALIAS => $cf_alias, FIELD => 'CustomField', VALUE => $cf->id );
$txns->Limit( ALIAS => $cf_alias, FIELD => 'ObjectType', VALUE => 'RT::Transaction' );
-$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_start->ISO, OPERATOR => '>=' );
-$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_end->ISO, OPERATOR => '<', ENTRYAGGREGATOR => 'AND', );
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_start->ISO(Time => 0), OPERATOR => '>=' );
+$txns->Limit( ALIAS => $cf_alias, FIELD => 'Content', VALUE => $week_end->ISO(Time => 0), OPERATOR => '<', ENTRYAGGREGATOR => 'AND', );
while ( my $txn = $txns->Next ) {
my $ticket = $txn->Object;
commit ebb470a3465d2ced782cdae4b7efb8701d9c3d55
Author: sunnavy <sunnavy at bestpractical.com>
Date: Tue Dec 3 23:59:03 2013 +0800
timezone fix
we shall show dates and calculate day of week based on user's timezone
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 01ae915..8c8ad6d 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -22,7 +22,7 @@
% }
<tr><td class="label">
<&|/l&>Week of (pick any day in week)</&>:</td>
-<td><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO') &></td></tr>
+<td><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO', Timezone => 'user') &></td></tr>
</table>
</form>
@@ -168,7 +168,7 @@ if ($Date) {
}
$date->SetToMidnight( Timezone => 'user' );
-my $wday = ($date->Localtime())[6] || 7;
+my $wday = ($date->Localtime('user'))[6] || 7;
my $week_start = RT::Date->new($user);
$week_start->Set( Value => $date->Unix );
$week_start->AddDays( -1 * $wday + 1 ) unless $wday == 1;
commit a598bdf550d5419062f1d75f39312eb58f4c7ef9
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Dec 4 20:57:24 2013 +0800
merge activity into tickets with time
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 8c8ad6d..8ef53f6 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -93,15 +93,6 @@
<input type="submit" class="button" value="<% loc('Save') %>">
</form>
-<&| /Widgets/TitleBox, title => loc('Activities') &>
-<& /Elements/CollectionList,
- OrderBy => 'id',
- Order => 'ASC',
- Format => $activity_format,
- Collection => $week_worked{$day}{activity_tickets},
-&>
-</&>
-
% }
<hr />
@@ -275,34 +266,26 @@ while ( my $txn = $txns->Next ) {
$total_time_worked += $txn->TimeTaken;
}
-my $activity_format =
- q{'<a href="__WebPath__/Ticket/Display.html?id=__id__">__id__</a>/TITLE:id/ALIGN:Left'}.
- q{,'<a href="__WebPath__/Ticket/Display.html?id=__id__">__Subject__</a>/TITLE:Subject'}.
- q{,__QueueName__,__OwnerName__,__LastUpdatedBy__,__DueRelative__,__LastUpdatedRelative__};
-
-for my $day ( keys %week_worked ) {
- my $start_date = $week_worked{$day}{date};
- my $end_date = RT::Date->new($user);
- $end_date->Set( Value => $start_date->Unix );
- $end_date->AddDays(1);
-
- my $activity_txns = RT::Transactions->new($user);
-
- $txns->Limit( FIELD => 'Creator', VALUE => $user->id );
- $activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
- $activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $start_date->ISO );
- $activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $end_date->ISO, ENTRYAGGREGATOR => 'AND' );
- $activity_txns->Limit( FIELD => 'Type', VALUE => 'Create' );
- $activity_txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
- $activity_txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
- $activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
- my @ticket_ids;
- while ( my $transaction = $activity_txns->Next ) {
- push @ticket_ids, $transaction->ObjectId;
+my $activity_txns = RT::Transactions->new($user);
+
+$txns->Limit( FIELD => 'Creator', VALUE => $user->id );
+$activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
+$activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $week_start->ISO );
+$activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $week_end->ISO, ENTRYAGGREGATOR => 'AND' );
+$activity_txns->Limit( FIELD => 'Type', VALUE => 'Create' );
+$activity_txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
+$activity_txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
+$activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
+my @ticket_ids;
+while ( my $txn = $activity_txns->Next ) {
+ my $ticket = $txn->Object;
+ my $worked_date = $txn->CreatedObj->ISO( Time => 0, Timezone => 'user' );
+ next unless $week_worked{$worked_date};
+ next if $week_worked{$worked_date}{tickets}{$ticket->id};
+ $week_worked{$worked_date}{tickets}{$ticket->id} = {
+ ticket => $ticket,
+ time_worked => 0,
}
- my $activity_tickets = RT::Tickets->new( $user );
- $activity_tickets->FromSQL( join ' OR ', map { "id = $_" } @ticket_ids );
- $week_worked{$day}{activity_tickets} = $activity_tickets;
}
</%INIT>
commit 27757b2f1c7c3628bd85df54c3a2d5900e50bed4
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Dec 5 09:35:42 2013 -0500
Change Add to Update since you can subtract time
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 8ef53f6..1760325 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -37,7 +37,7 @@
<th class="collection-as-table"><&|/l&>Status</&></th>
<th class="collection-as-table"><&|/l&>Owner</&></th>
<th class="collection-as-table"><&|/l&>Time Worked</&></th>
-<th class="collection-as-table"><&|/l&>Add</&></th>
+<th class="collection-as-table"><&|/l&>Update</&></th>
</tr>
% my $i = 1;
% for my $ticket_id ( sort { $a <=> $b } keys %{$week_worked{$day}{tickets}} ) {
commit 523ee5e1105b0ae6d7053c5a0d09759aaeac204e
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Dec 6 15:46:05 2013 -0500
Update MANIFEST
diff --git a/MANIFEST b/MANIFEST
index 35dc5e9..dc269de 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,8 +1,10 @@
etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
etc/initialdata
html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
+html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/ShowComponentName
html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+html/Elements/ShowCustomFieldActor
html/Tools/MyWeek.html
inc/Module/Install.pm
inc/Module/Install/Base.pm
commit 67ec5256db7391b5ec3e5e77195d3a08e8d314e0
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Dec 11 22:34:25 2013 +0800
show total time worked by all users in Basics
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
index 121612a..449c2c2 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -1,4 +1,20 @@
<%init>
+
+my $time_worked;
+if ( $TicketObj->TimeWorked ) {
+ $time_worked = {};
+ my $transactions = $TicketObj->Transactions;
+ $transactions->Limit(
+ FIELD => 'TimeTaken',
+ VALUE => 0,
+ OPERATOR => '>',
+ );
+
+ while ( my $txn = $transactions->Next ) {
+ $time_worked->{ $txn->CreatorObj->Name } += $txn->TimeTaken;
+ }
+}
+
# The self service interface doesn't support updating time fields.
return unless $session{CurrentUser}->Privileged
and $session{CurrentUser}->HasRight( Object => $TicketObj, Right => "ModifyTicket" );
@@ -41,6 +57,23 @@ input#<% $cf_style %> {
</td>
</tr>
+% if ( $TicketObj->TimeWorked ) {
+<tr class="time worked">
+ <td class="label"><&|/l&>Worked</&>:</td>
+ <td>
+ <table>
+% for my $user ( keys %$time_worked ) {
+ <tr>
+% # add "value" class for $user label is to make the font the same size as value
+ <td class="value"><% $user %>:</td>
+ <td class="value"><& /Ticket/Elements/ShowTime, minutes => $time_worked->{$user} &></td>
+ </tr>
+% }
+ </table>
+ </td>
+</tr>
+% }
+
<%args>
$TicketObj
</%args>
commit 000fe74ee46081990106f90fe19956c5d9767cd9
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Dec 11 22:36:43 2013 +0800
in case timetaken is negative
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
index 449c2c2..f141583 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -7,7 +7,7 @@ if ( $TicketObj->TimeWorked ) {
$transactions->Limit(
FIELD => 'TimeTaken',
VALUE => 0,
- OPERATOR => '>',
+ OPERATOR => '!=',
);
while ( my $txn = $transactions->Next ) {
commit 101077b53b244c24ca0910c454622fab1fcbb18b
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Dec 18 20:03:30 2013 +0800
"End" callback for MyWeek page
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 1760325..0b479af 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -100,6 +100,8 @@
<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
</div>
+% $m->callback( CallbackName => 'End', User => $user, Date => $date );
+
</div>
<%INIT>
my $user;
commit b2d017ada8ebeb4223b0ca05e354683ccf783dae
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Dec 18 23:52:31 2013 +0800
new option $TimeTrackingFirstDayOfWeek
diff --git a/README b/README
index 5ecd72b..da13aae 100644
--- a/README
+++ b/README
@@ -26,6 +26,11 @@ INSTALLATION
or add "RT::Extension::TimeTracking" to your existing @Plugins line.
+ The default week start day in MyWeek page is Monday, you can change
+ it by setting $TimeTrackingFirstDayOfWeek, e.g.
+
+ Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+
Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 0b479af..dad7f3f 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -4,6 +4,15 @@
<& /Elements/ListActions, actions => \@results &>
+<script type="text/javascript">
+jQuery( function() {
+ if ( <% $offset %> != 6 ) { // Sunday
+ // Monday's $offset is 0, that's why we +1 here
+ jQuery("div.time_tracking input[name=Date]").datepicker( 'option', 'firstDay', <% $offset + 1 %> );
+ }
+});
+
+</script>
<div class="time_tracking">
<form>
@@ -161,7 +170,29 @@ if ($Date) {
}
$date->SetToMidnight( Timezone => 'user' );
+my @week_name = qw/Monday Tuesday Wednesday Thursday Friday Saturday Sunday/;
+my %week_index;
+{
+ my $index = 0;
+ %week_index = map { $_ => $index++ } @week_name;
+}
+
+my $first_day = RT->Config->Get('TimeTrackingFirstDayOfWeek');
+my $offset = 0;
+if ( $first_day && $first_day !~ /Monday/i ) {
+ $first_day = ucfirst lc $first_day;
+ if ( $week_index{$first_day} ) {
+ $offset = $week_index{$first_day};
+ @week_name = ( @week_name[$week_index{$first_day}..$#week_name], at week_name[0 .. $week_index{$first_day}-1] );
+ }
+ else {
+ RT->Logger->warning("Invalid TimeTrackingFirstDayOfWeek value($first_day), should be one of Monday, Tuesday, etc.");
+ }
+}
+
my $wday = ($date->Localtime('user'))[6] || 7;
+$wday -= $offset;
+$wday += 7 if $wday < 0;
my $week_start = RT::Date->new($user);
$week_start->Set( Value => $date->Unix );
$week_start->AddDays( -1 * $wday + 1 ) unless $wday == 1;
@@ -171,7 +202,7 @@ $week_end->Set( Value => $date->Unix );
$week_end->AddDays( 8 - $wday );
my %week_worked;
-my @week_name = qw/Monday Tuesday Wednesday Thursday Friday Saturday Sunday/;
+
for my $offset ( 0 .. 6 ) {
my $date = RT::Date->new($user);
$date->Set( Value => $week_start->Unix );
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 4a21079..72a481d 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -47,6 +47,11 @@ Add this line:
or add C<RT::Extension::TimeTracking> to your existing C<@Plugins> line.
+The default week start day in MyWeek page is Monday, you can change it by
+setting C<$TimeTrackingFirstDayOfWeek>, e.g.
+
+ Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+
=item Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
commit 02d08239756c268fad2f2dc3a690dd16b4c123e9
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Dec 18 16:54:37 2013 -0500
Apply limit to the activity txns
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index dad7f3f..f787ae3 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -301,7 +301,7 @@ while ( my $txn = $txns->Next ) {
my $activity_txns = RT::Transactions->new($user);
-$txns->Limit( FIELD => 'Creator', VALUE => $user->id );
+$activity_txns->Limit( FIELD => 'Creator', VALUE => $user->id );
$activity_txns->Limit( FIELD => 'ObjectType', VALUE => 'RT::Ticket' );
$activity_txns->Limit( FIELD => 'Created', OPERATOR => '>=', VALUE => $week_start->ISO );
$activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $week_end->ISO, ENTRYAGGREGATOR => 'AND' );
commit 72e5cddbd95eb361c9fe9b83d59422f253e1d71c
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Dec 19 09:30:56 2013 +0800
hide txn cf actor on ticket updates
we don't want user to manually set it.
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/EditTransactionCustomFields/MassageTransactionCustomFields b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/EditTransactionCustomFields/MassageTransactionCustomFields
new file mode 100644
index 0000000..f4c547d
--- /dev/null
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/EditTransactionCustomFields/MassageTransactionCustomFields
@@ -0,0 +1,7 @@
+<%INIT>
+$CustomFields->Limit( FIELD => 'Name', VALUE => 'Actor', OPERATOR => '!=', CASESENSITIVE => 0 );
+</%INIT>
+
+<%ARGS>
+$CustomFields
+</%ARGS>
commit fd623a18d8c660a784ceda9037c38ded8dec23c9
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Dec 19 22:53:15 2013 +0800
add %week_worked to callback
it's useful to find related tickets
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index f787ae3..c7ca2eb 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -109,7 +109,7 @@ jQuery( function() {
<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
</div>
-% $m->callback( CallbackName => 'End', User => $user, Date => $date );
+% $m->callback( CallbackName => 'End', User => $user, Date => $date, WeekWorked => \%week_worked );
</div>
<%INIT>
commit 1f89f4c9cfc71bea7e206680324c4d07cbf3e837
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Dec 19 15:50:17 2013 -0500
Update MANIFEST
diff --git a/MANIFEST b/MANIFEST
index dc269de..cf29199 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -3,6 +3,7 @@ etc/initialdata
html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/ShowComponentName
html/Callbacks/RT-Extension-TimeTracking/Elements/Tabs/Privileged
+html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/EditTransactionCustomFields/MassageTransactionCustomFields
html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
html/Elements/ShowCustomFieldActor
html/Tools/MyWeek.html
commit a60d1ba3a8937bb89342779a288f2ace64551c9c
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Mar 5 14:07:43 2014 -0500
Add and update Module::Install files
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/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/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/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index 6a80818..b5e03c3 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,7 +7,7 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.20';
+$VERSION = '0.22';
sub readme_from {
my $self = shift;
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 bb462d314803f8409f84304c1332fced41d17ffa
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Mar 5 14:09:14 2014 -0500
Add testing framework
diff --git a/.gitignore b/.gitignore
index cfec740..578fa98 100644
--- a/.gitignore
+++ b/.gitignore
@@ -12,3 +12,4 @@ pod2htm*.tmp
/MYMETA.*
/t/tmp
/xt/tmp
+/lib/RT/Extension/TimeTracking/Test.pm
diff --git a/Makefile.PL b/Makefile.PL
index 0ab5646..9041e42 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,9 +1,31 @@
use inc::Module::Install;
-
RTx 'RT-Extension-TimeTracking';
all_from 'lib/RT/Extension/TimeTracking.pm';
readme_from 'lib/RT/Extension/TimeTracking.pm';
license 'gplv2';
+my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
+
+# 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,
+ PERL => $ENV{PERL} || $secure_perl_path,
+ },
+ {
+ sufix => '.in'
+ },
+ qw(lib/RT/Extension/TimeTracking/Test.pm),
+);
+
+auto_install();
WriteAll;
diff --git a/lib/RT/Extension/TimeTracking/Test.pm.in b/lib/RT/Extension/TimeTracking/Test.pm.in
new file mode 100644
index 0000000..713f586
--- /dev/null
+++ b/lib/RT/Extension/TimeTracking/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::TimeTracking::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::TimeTracking';
+ } else {
+ $args{'testing'} = 'RT::Extension::TimeTracking';
+ }
+
+ $class->SUPER::import( %args );
+ $class->export_to_level(1);
+
+ require RT::Extension::TimeTracking;
+}
+
+1;
commit d6469223da1a3590d99aa3aab1214158e53de191
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Mar 6 10:57:39 2014 -0500
Create new WeekStartDate function to calculate first weekday
Move code to calculate the first day of the week to a function.
Switch to Time::ParseDate rather than manually calculating the
day.
diff --git a/META.yml b/META.yml
index 9be4f2a..248e490 100644
--- a/META.yml
+++ b/META.yml
@@ -20,6 +20,7 @@ no_index:
- html
- inc
- static
+ - xt
resources:
license: http://opensource.org/licenses/gpl-license.php
version: 0.01
diff --git a/README b/README
index da13aae..a94d0b2 100644
--- a/README
+++ b/README
@@ -36,6 +36,15 @@ INSTALLATION
Restart your webserver
+METHODS
+ WeekStartDate
+ Accepts an RT::User object, an RT::Date object and a day of the week
+ (Monday, Tuesday, etc.) and calculates the start date for the week the
+ date object is in using the passed day as the first day of the week. The
+ default first day of the week is Monday.
+
+ Returns an RT::Date object set to the calculated date.
+
AUTHOR
sunnavy <sunnavy at bestpractical.com>
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index c7ca2eb..a5d47ff 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -6,10 +6,7 @@
<script type="text/javascript">
jQuery( function() {
- if ( <% $offset %> != 6 ) { // Sunday
- // Monday's $offset is 0, that's why we +1 here
- jQuery("div.time_tracking input[name=Date]").datepicker( 'option', 'firstDay', <% $offset + 1 %> );
- }
+ jQuery("div.time_tracking input[name=Date]").datepicker( 'option', 'firstDay', <% ($week_start->Localtime('user'))[6] %> );
});
</script>
@@ -170,36 +167,12 @@ if ($Date) {
}
$date->SetToMidnight( Timezone => 'user' );
-my @week_name = qw/Monday Tuesday Wednesday Thursday Friday Saturday Sunday/;
-my %week_index;
-{
- my $index = 0;
- %week_index = map { $_ => $index++ } @week_name;
-}
-
-my $first_day = RT->Config->Get('TimeTrackingFirstDayOfWeek');
-my $offset = 0;
-if ( $first_day && $first_day !~ /Monday/i ) {
- $first_day = ucfirst lc $first_day;
- if ( $week_index{$first_day} ) {
- $offset = $week_index{$first_day};
- @week_name = ( @week_name[$week_index{$first_day}..$#week_name], at week_name[0 .. $week_index{$first_day}-1] );
- }
- else {
- RT->Logger->warning("Invalid TimeTrackingFirstDayOfWeek value($first_day), should be one of Monday, Tuesday, etc.");
- }
-}
-
-my $wday = ($date->Localtime('user'))[6] || 7;
-$wday -= $offset;
-$wday += 7 if $wday < 0;
-my $week_start = RT::Date->new($user);
-$week_start->Set( Value => $date->Unix );
-$week_start->AddDays( -1 * $wday + 1 ) unless $wday == 1;
+my ($ret, $week_start) = RT::Extension::TimeTracking::WeekStartDate($user,
+ $date, RT->Config->Get('TimeTrackingFirstDayOfWeek'));
my $week_end = RT::Date->new($user);
-$week_end->Set( Value => $date->Unix );
-$week_end->AddDays( 8 - $wday );
+$week_end->Set( Value => $week_start->Unix );
+$week_end->AddDays( 6 );
my %week_worked;
@@ -209,7 +182,7 @@ for my $offset ( 0 .. 6 ) {
$date->AddDays( $offset ) if $offset;
$week_worked{$date->ISO(Time => 0, Timezone => 'user')} = {
date => $date,
- week_name => $week_name[$offset],
+ week_name => $RT::Extension::TimeTracking::DAYS_OF_WEEK[$offset],
tickets => {},
};
}
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 72a481d..8892c1d 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -9,6 +9,27 @@ RT->AddJavaScript("time_tracking.js");
RT::System->AddRight( Admin => AdminTimesheets => 'Add time worked for other users' );
+# RT::Date does weedkay abbreviations, but not full weekday names.
+our @DAYS_OF_WEEK = (
+ 'Sunday',
+ 'Monday',
+ 'Tuesday',
+ 'Wednesday',
+ 'Thursday',
+ 'Friday',
+ 'Saturday',
+);
+
+our %WEEK_INDEX = (
+ Sunday => 0,
+ Monday => 1,
+ Tuesday => 2,
+ Wednesday => 3,
+ Thursday => 4,
+ Friday => 5,
+ Saturday => 6,
+);
+
=head1 NAME
RT-Extension-TimeTracking - Time Tracking Extension
@@ -60,6 +81,50 @@ setting C<$TimeTrackingFirstDayOfWeek>, e.g.
=back
+=head1 METHODS
+
+=head2 WeekStartDate
+
+Accepts an RT::User object, an RT::Date object and a day of the week (Monday,
+Tuesday, etc.) and calculates the start date for the week the date object is
+in using the passed day as the first day of the week. The default
+first day of the week is Monday.
+
+Returns an RT::Date object set to the calculated date.
+
+=cut
+
+sub WeekStartDate {
+ my $user = shift;
+ my $date = shift;
+ my $first_day = shift;
+
+ $first_day //= 'Monday';
+ $first_day = ucfirst lc $first_day;
+
+ unless ( $first_day and exists $WEEK_INDEX{$first_day} ){
+ RT->Logger->warning("Invalid TimeTrackingFirstDayOfWeek value: "
+ . "$first_day. It should be one of Monday, Tuesday, etc.");
+ return (0, "Invalid day of week set for TimeTrackingFirstDayOfWeek");
+ }
+
+ my $day = ($date->Localtime('user'))[6];
+ my $week_start = RT::Date->new($user);
+
+ if ( $day == $WEEK_INDEX{$first_day} ){
+ # Set to same day passed in
+ $week_start->Set( Format => 'unix', Value => $date->Unix );
+ }
+ else{
+ # Calculate date of first day of the week
+ my $seconds = Time::ParseDate::parsedate("last $first_day",
+ NOW => $date->Unix );
+ $week_start->Set( Format => 'unix', Value => $seconds );
+ }
+
+ return (1, $week_start);
+}
+
=head1 AUTHOR
sunnavy <sunnavy at bestpractical.com>
diff --git a/xt/work_week.t b/xt/work_week.t
new file mode 100644
index 0000000..566a58b
--- /dev/null
+++ b/xt/work_week.t
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use RT::Extension::TimeTracking::Test tests => undef;
+use Test::Warn;
+
+use_ok('RT::Extension::TimeTracking');
+
+my $user = RT::User->new(RT->SystemUser);
+$user->Load(RT->SystemUser);
+
+my $date = RT::Date->new(RT->SystemUser);
+$date->SetToNow;
+
+warning_like { RT::Extension::TimeTracking::WeekStartDate($user, $date, 'foo') }
+ qr/Invalid TimeTrackingFirstDayOfWeek value/i, "Incorrect day of week";
+
+$date->Set(Format => 'unknown', Value => '2014-01-12 00:00:00', Timezone => 'user' );
+my ($ret, $start) = RT::Extension::TimeTracking::WeekStartDate($user, $date, 'Monday');
+is( $start->ISO( Timezone => 'user'), '2014-01-06 00:00:00', "Got the previous Monday when passing Sunday");
+
+$date->Set(Format => 'unknown', Value => '2014-01-13 00:00:00', Timezone => 'user' );
+($ret, $start) = RT::Extension::TimeTracking::WeekStartDate($user, $date, 'Monday');
+is( $start->ISO( Timezone => 'user'), '2014-01-13 00:00:00', "Got Monday when passing Monday");
+
+$date->Set(Format => 'unknown', Value => '2014-01-14 00:00:00', Timezone => 'user' );
+($ret, $start) = RT::Extension::TimeTracking::WeekStartDate($user, $date, 'Monday');
+is( $start->ISO( Timezone => 'user'), '2014-01-13 00:00:00', "Got Monday when passing Tuesday");
+
+$date->Set(Format => 'unknown', Value => '2014-01-14 00:00:00', Timezone => 'user' );
+($ret, $start) = RT::Extension::TimeTracking::WeekStartDate($user, $date);
+is( $start->ISO( Timezone => 'user'), '2014-01-13 00:00:00', "Got Monday as default when passing Tuesday");
+
+done_testing();
commit 1459920051cc1c1f9ad5b479c123d7e6b4b4cb95
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Mar 7 10:28:00 2014 -0500
Pass Timezone to get the proper default date for time entry
Without timezone, Date was using UTC so after midnight UTC
the day would advance even though it was still the previous
day in the user's timezone.
diff --git a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
index f141583..c714913 100644
--- a/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
+++ b/html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
@@ -46,7 +46,7 @@ input#<% $cf_style %> {
<td class="value">
<form action="<% RT->Config->Get("WebPath") %>/Ticket/Display.html" method="POST">
<input type="hidden" name="id" value="<% $TicketObj->id %>">
- <& /Elements/SelectDate, Name => "$cf_name", current => 0, ShowTime => 0, Default => $today->Date &>
+ <& /Elements/SelectDate, Name => "$cf_name", current => 0, ShowTime => 0, Default => $today->Date( Timezone => 'user') &>
<& /Elements/EditTimeValue,
Name => "UpdateTimeWorked",
Default => $ARGS{UpdateTimeWorked} || '',
commit f26c269a08ccc126d06dfae573df0bc021acb9e8
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Mar 7 10:43:50 2014 -0500
Prep for 0.02 release
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..b9a2dac
--- /dev/null
+++ b/Changes
@@ -0,0 +1,9 @@
+Revision history for RT-Extension-TimeTracking
+
+0.02 2014-03-07
+ * Use the user's timezone to set the default date for entering time
+ * Refactor first day of week handling to avoid flipping to the next
+ week on the last day of the week
+
+0.01 2013-12-19
+ * Initial release.
diff --git a/MANIFEST b/MANIFEST
index cf29199..c388e6f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,4 @@
+Changes
etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
etc/initialdata
html/Callbacks/RT-Extension-TimeTracking/Elements/ShowCustomFields/MassageCustomFields
@@ -7,21 +8,27 @@ html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/EditTransactionCustomFi
html/Callbacks/RT-Extension-TimeTracking/Ticket/Elements/ShowBasics/EndOfList
html/Elements/ShowCustomFieldActor
html/Tools/MyWeek.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/ReadmeFromPod.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/TimeTracking.pm
+lib/RT/Extension/TimeTracking/Test.pm.in
Makefile.PL
MANIFEST This list of files
META.yml
README
static/css/time_tracking.css
static/js/time_tracking.js
+xt/work_week.t
diff --git a/META.yml b/META.yml
index 248e490..336027d 100644
--- a/META.yml
+++ b/META.yml
@@ -23,4 +23,4 @@ no_index:
- xt
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.01
+version: 0.02
diff --git a/README b/README
index a94d0b2..de143c8 100644
--- a/README
+++ b/README
@@ -17,6 +17,8 @@ INSTALLATION
in case changes need to be made to your database.
patch RT
+ Only run this the first time you install this module.
+
patch -p1 -d /path/to/rt < etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
Edit your /opt/rt4/etc/RT_SiteConfig.pm
@@ -26,16 +28,18 @@ INSTALLATION
or add "RT::Extension::TimeTracking" to your existing @Plugins line.
- The default week start day in MyWeek page is Monday, you can change
- it by setting $TimeTrackingFirstDayOfWeek, e.g.
-
- Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
-
Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
Restart your webserver
+CONFIGURATION
+ $TimeTrackingFirstDayOfWeek
+ The default week start day in MyWeek page is Monday, you can change it
+ by setting $TimeTrackingFirstDayOfWeek, e.g.
+
+ Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+
METHODS
WeekStartDate
Accepts an RT::User object, an RT::Date object and a day of the week
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 8892c1d..97c9b39 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::TimeTracking;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
RT->AddStyleSheets("time_tracking.css");
RT->AddJavaScript("time_tracking.js");
@@ -58,6 +58,8 @@ in case changes need to be made to your database.
=item patch RT
+Only run this the first time you install this module.
+
patch -p1 -d /path/to/rt < etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
=item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
@@ -68,11 +70,6 @@ Add this line:
or add C<RT::Extension::TimeTracking> to your existing C<@Plugins> line.
-The default week start day in MyWeek page is Monday, you can change it by
-setting C<$TimeTrackingFirstDayOfWeek>, e.g.
-
- Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
-
=item Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
@@ -81,6 +78,15 @@ setting C<$TimeTrackingFirstDayOfWeek>, e.g.
=back
+=head1 CONFIGURATION
+
+=head2 C<$TimeTrackingFirstDayOfWeek>
+
+The default week start day in MyWeek page is Monday, you can change it by
+setting C<$TimeTrackingFirstDayOfWeek>, e.g.
+
+ Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+
=head1 METHODS
=head2 WeekStartDate
commit 71409864e887fec6924ef2d6bd62f98815305757
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Mar 7 10:59:21 2014 -0500
Add RT version information to docs
diff --git a/README b/README
index de143c8..3bd8ff0 100644
--- a/README
+++ b/README
@@ -1,6 +1,9 @@
NAME
RT-Extension-TimeTracking - Time Tracking Extension
+RT VERSION
+ Works with RT 4.2
+
INSTALLATION
"perl Makefile.PL"
"make"
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 97c9b39..703c5c6 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -34,6 +34,10 @@ our %WEEK_INDEX = (
RT-Extension-TimeTracking - Time Tracking Extension
+=head1 RT VERSION
+
+Works with RT 4.2
+
=head1 INSTALLATION
=over
commit f6211fa49acffa3979dd08cec0c3e1f7c8348c54
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Mar 12 19:50:16 2014 +0800
end week should be +7
I don't know what I was thinking when I wrote +6
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index a5d47ff..18f6a54 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -172,7 +172,7 @@ my ($ret, $week_start) = RT::Extension::TimeTracking::WeekStartDate($user,
my $week_end = RT::Date->new($user);
$week_end->Set( Value => $week_start->Unix );
-$week_end->AddDays( 6 );
+$week_end->AddDays( 7 );
my %week_worked;
commit ad79e5ac77932ecbde18126fd466248765159871
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Mar 12 20:27:05 2014 +0800
fix weekday name when there is customized week start day
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 18f6a54..4da3a5a 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -176,13 +176,21 @@ $week_end->AddDays( 7 );
my %week_worked;
+my @week_names = @RT::Extension::TimeTracking::DAYS_OF_WEEK;
+if ( RT->Config->Get('TimeTrackingFirstDayOfWeek') ) {
+ my $offset = $RT::Extension::TimeTracking::WEEK_INDEX{RT->Config->Get('TimeTrackingFirstDayOfWeek')};
+ if ( $offset ) {
+ @week_names = @week_names[$offset .. $#week_names, 0 .. $offset -1 ];
+ }
+}
+
for my $offset ( 0 .. 6 ) {
my $date = RT::Date->new($user);
$date->Set( Value => $week_start->Unix );
$date->AddDays( $offset ) if $offset;
$week_worked{$date->ISO(Time => 0, Timezone => 'user')} = {
date => $date,
- week_name => $RT::Extension::TimeTracking::DAYS_OF_WEEK[$offset],
+ week_name => $week_names[$offset],
tickets => {},
};
}
commit 99248181b28134de772c75a9b44c9ca6c6d76856
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Mar 12 23:05:26 2014 +0800
fix week day list issues raised by daylight saving
this is an edge issue when we just entered dst. take 2014-03-11 for example,
if TimeTrackingFirstDayOfWeek is set to "Wednesday" then the week will
be 2014-03-05 -- 2014-03-11. without this commit, the week days are actaully
2014-03-04 -- 2014-03-08, and then jumps to 2014-03-10, 2014-03-11.
this is because when we call ->AddDays, we simply add seconds(24*3600)
actually instead of days, which is not right when dst is involved.
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 4da3a5a..c3a3179 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -188,6 +188,11 @@ for my $offset ( 0 .. 6 ) {
my $date = RT::Date->new($user);
$date->Set( Value => $week_start->Unix );
$date->AddDays( $offset ) if $offset;
+ my $user_hour = ($date->Localtime('user'))[2];
+ if ( $user_hour == 23 ) {
+ $date->AddSeconds(3600); # to get around isuses raised by daylight saving
+ }
+
$week_worked{$date->ISO(Time => 0, Timezone => 'user')} = {
date => $date,
week_name => $week_names[$offset],
commit 6e5f2695acb28f5373db9fff5b3b8a24d0f08033
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Mar 12 15:34:49 2014 -0400
Prep for 0.03 release
diff --git a/Changes b/Changes
index b9a2dac..21a9253 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,10 @@
Revision history for RT-Extension-TimeTracking
+0.03 2014-03-12
+ * Fix daylight savings time issue
+ * Fix week end offset
+ * Fix weekday name in timesheet when custom first day of week selected
+
0.02 2014-03-07
* Use the user's timezone to set the default date for entering time
* Refactor first day of week handling to avoid flipping to the next
diff --git a/META.yml b/META.yml
index 336027d..9790fdf 100644
--- a/META.yml
+++ b/META.yml
@@ -23,4 +23,4 @@ no_index:
- xt
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.02
+version: 0.03
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 703c5c6..cd5ea45 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::TimeTracking;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
RT->AddStyleSheets("time_tracking.css");
RT->AddJavaScript("time_tracking.js");
commit 66d0d485e5d20a4a1f5ccab4f5aa21daad86fe8f
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Mar 12 16:42:26 2014 -0400
Add option to display a cf with ticket data
diff --git a/README b/README
index 3bd8ff0..a09c590 100644
--- a/README
+++ b/README
@@ -43,6 +43,15 @@ CONFIGURATION
Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+ $TimeTrackingDisplayCF
+ In the ticket listings on the My Week page, there is a room for an
+ additional field next to Status, Owner, etc. To display a custom field
+ that might be helpful when filling out your timesheet, you can set
+ $TimeTrackingDisplayCF to the name of that custom field. In the display,
+ that field name will be added to the ticket heading between Owner and
+ Time Worked for each day on My Week. The value will be populated for
+ each ticket.
+
METHODS
WeekStartDate
Accepts an RT::User object, an RT::Date object and a day of the week
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index c3a3179..00721f9 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -42,6 +42,9 @@ jQuery( function() {
<th class="collection-as-table"><&|/l&>Subject</&></th>
<th class="collection-as-table"><&|/l&>Status</&></th>
<th class="collection-as-table"><&|/l&>Owner</&></th>
+% if ( $display_cf ){
+<th class="collection-as-table"><% $display_cf %></th>
+% }
<th class="collection-as-table"><&|/l&>Time Worked</&></th>
<th class="collection-as-table"><&|/l&>Update</&></th>
</tr>
@@ -58,6 +61,9 @@ jQuery( function() {
</td>
<td class="collection-as-table"><% $ticket->Status %></td>
<td class="collection-as-table"><% $ticket->OwnerObj->Name %></td>
+% if ( $display_cf ){
+<td class="collection-as-table"><% $ticket->FirstCustomFieldValue($display_cf) %></td>
+% }
<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
<td class="collection-as-table">
<form method="POST">
@@ -159,6 +165,19 @@ if ( defined $ARGS{'UpdateTimeWorked'} ) {
);
}
+# Do we need to load a CF for display?
+my $display_cf;
+if ( $display_cf = RT->Config->Get('TimeTrackingDisplayCF') ){
+ my $confirm_cf = RT::CustomField->new(RT->SystemUser);
+ my ($ret, $msg) = $confirm_cf->Load($display_cf);
+
+ if ( not $ret ){
+ RT::Logger->error("Unable to load custom field $display_cf "
+ . "defined via config option TimeTrackingDisplayCF: $msg");
+ undef $display_cf;
+ }
+}
+
my $date = RT::Date->new($user);
if ($Date) {
$date->Set(Value => $Date, Format => 'unknown');
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index cd5ea45..81c5257 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -91,6 +91,15 @@ setting C<$TimeTrackingFirstDayOfWeek>, e.g.
Set($TimeTrackingFirstDayOfWeek, 'Wednesday');
+=head2 C<$TimeTrackingDisplayCF>
+
+In the ticket listings on the My Week page, there is a room for an additional
+field next to Status, Owner, etc. To display a custom field that might be
+helpful when filling out your timesheet, you can set $TimeTrackingDisplayCF
+to the name of that custom field. In the display, that field name will be
+added to the ticket heading between Owner and Time Worked for each
+day on My Week. The value will be populated for each ticket.
+
=head1 METHODS
=head2 WeekStartDate
commit 6adf0134c9ba25c1efad73375cee3c8439d2bed3
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Mar 13 10:35:51 2014 -0400
Prep for 0.04 release
diff --git a/Changes b/Changes
index 21a9253..ca395c3 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
Revision history for RT-Extension-TimeTracking
+0.04 2014-03-13
+ * Add $TimeTrackingDisplayCF feature
+
0.03 2014-03-12
* Fix daylight savings time issue
* Fix week end offset
diff --git a/META.yml b/META.yml
index 9790fdf..e9c2424 100644
--- a/META.yml
+++ b/META.yml
@@ -23,4 +23,4 @@ no_index:
- xt
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.03
+version: 0.04
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 81c5257..5b04459 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::TimeTracking;
-our $VERSION = '0.03';
+our $VERSION = '0.04';
RT->AddStyleSheets("time_tracking.css");
RT->AddJavaScript("time_tracking.js");
commit 98209155306f549453c31afb2070a5c6e9940887
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Mar 28 16:25:54 2014 -0400
My Week layout changes and updates
* Move per-ticket save button to a single day button
* Tweak layout for new daily save button
* When adding tickets, change button to Add from Save
* Restore standard left align for text in ticket layout
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 00721f9..1145696 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -10,6 +10,11 @@ jQuery( function() {
});
</script>
+<style type="text/css">
+input#Date {
+ width: 177px;
+}
+</style>
<div class="time_tracking">
<form>
@@ -22,20 +27,26 @@ jQuery( function() {
<tr><td class="label">
<input type="hidden" name="User" value="<% $User || '' %>" />
<&|/l&>Go to user</&>:</td>
-<td><input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" /></td>
+<td class="value"><input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" /></td>
</tr>
</div>
% }
<tr><td class="label">
<&|/l&>Week of (pick any day in week)</&>:</td>
-<td><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO', Timezone => 'user') &></td></tr>
+<td class="value"><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO', Timezone => 'user') &></td></tr>
</table>
</form>
% for my $day ( sort keys %week_worked ) {
+<div class="day_entry">
<h2><% $week_worked{$day}{date}->RFC2822(Time => 0, Timezone => 'user') %></h2>
% if ( %{$week_worked{$day}{tickets}} ) {
+<form method="POST">
+<input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
+% if ( $user->id != $session{CurrentUser}->id ) {
+<input type="hidden" value="<% $session{CurrentUser}->id %>" name="Object-RT::Transaction--CustomField-<% $actor_cf->id %>-Values" />
+% }
<table class="ticket-list collection-as-table">
<tr class="collection-as-table">
<th class="collection-as-table"><&|/l&>id</&></th>
@@ -66,30 +77,26 @@ jQuery( function() {
% }
<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
<td class="collection-as-table">
-<form method="POST">
- <input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
-% if ( $user->id != $session{CurrentUser}->id ) {
- <input type="hidden" value="<% $session{CurrentUser}->id %>" name="Object-RT::Transaction--CustomField-<% $actor_cf->id %>-Values" />
-% }
<input name="id" type="hidden" value=<% $ticket->id %> />
<& /Elements/EditTimeValue,
Name => "UpdateTimeWorked",
Default => '',
InUnits => $DefaultTimeUnits || 'minutes',
&>
- <input type="submit" class="button" value="<% loc('Save') %>">
-</form>
</td>
</tr>
-% }
+% } # end for my $day
</table>
-
-<div class="time_worked">
+<div class="submit_day_time_button">
+<input type="submit" class="button" value="Save <% $week_worked{$day}{week_name} %> Updates">
+</div>
+</form>
+<div class="time_worked_day">
<span class="label"><&|/l&><% $week_worked{$day}{week_name} %> Total</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $week_worked{$day}{time_worked} &></span>
</div>
% }
-
+<div class="add_new_time_entry">
<form method="POST">
<input type="hidden" value="<% $day %>" name="Object-RT::Transaction--CustomField-<% $date_cf->id %>-Values" />
% if ( $user->id != $session{CurrentUser}->id ) {
@@ -102,13 +109,13 @@ jQuery( function() {
Default => '',
InUnits => $DefaultTimeUnits || 'minutes',
&>
- <input type="submit" class="button" value="<% loc('Save') %>">
+ <input type="submit" class="button" value="<% loc('Add') %>">
</form>
-
+</div></div>
% }
<hr />
-<div class="time_worked">
+<div class="time_worked_week">
<span class="label"><&|/l&>Total Time Worked</&>:</span> <span class="value"><& /Ticket/Elements/ShowTime, minutes => $total_time_worked &></span>
</div>
diff --git a/static/css/time_tracking.css b/static/css/time_tracking.css
index 3eb85f1..e710900 100644
--- a/static/css/time_tracking.css
+++ b/static/css/time_tracking.css
@@ -1,9 +1,35 @@
-div.time_tracking div.time_worked {
+div.time_tracking {
clear: both;
- text-align: right;
margin-right: 20px;
}
+div.day_entry {
+ clear: both;
+ position: relative;
+}
+
+div.submit_day_time_button {
+ position: absolute;
+ bottom: 0;
+ right: 0;
+}
+
+div.time_worked_day {
+ position: absolute;
+ bottom: -20px;
+ right: 5px;
+}
+
+div.time_worked_week {
+ text-align: right;
+}
+
+div.add_new_time_entry {
+ text-align: left;
+}
+
div.time_tracking h2 {
+ text-align: left;
margin-top: 30px;
}
+
commit 6810595b02ee6c702ee8e4229f9b994579ff51b2
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Apr 3 14:49:54 2014 -0400
Apply the week offset in all cases, not only when first day is set
The array of weekdays was only being reordered when a custom
first day was set via $TimeTrackingFirstDayOfWeek, so setting
a default first day of Monday resulted in incorrect weekdays
because the weekday hash starts on Sunday, consistent with
localtime. Remove the condition and always apply the offset.
diff --git a/README b/README
index a09c590..db37094 100644
--- a/README
+++ b/README
@@ -59,7 +59,14 @@ METHODS
date object is in using the passed day as the first day of the week. The
default first day of the week is Monday.
- Returns an RT::Date object set to the calculated date.
+ Returns:
+
+ ($ret, $week_start, $first_day)
+
+ where $ret is true on success, false on error, $week_start is an
+ RT::Date object set to the calculated date, and $first_day is a string
+ of the first day of the week, either from $TimeTrackingFirstDayOfWeek or
+ the default of Monday.
AUTHOR
sunnavy <sunnavy at bestpractical.com>
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 1145696..ebc9c78 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -193,8 +193,8 @@ if ($Date) {
}
$date->SetToMidnight( Timezone => 'user' );
-my ($ret, $week_start) = RT::Extension::TimeTracking::WeekStartDate($user,
- $date, RT->Config->Get('TimeTrackingFirstDayOfWeek'));
+my ($ret, $week_start, $first_day) = RT::Extension::TimeTracking::WeekStartDate(
+ $user, $date, RT->Config->Get('TimeTrackingFirstDayOfWeek'));
my $week_end = RT::Date->new($user);
$week_end->Set( Value => $week_start->Unix );
@@ -203,11 +203,9 @@ $week_end->AddDays( 7 );
my %week_worked;
my @week_names = @RT::Extension::TimeTracking::DAYS_OF_WEEK;
-if ( RT->Config->Get('TimeTrackingFirstDayOfWeek') ) {
- my $offset = $RT::Extension::TimeTracking::WEEK_INDEX{RT->Config->Get('TimeTrackingFirstDayOfWeek')};
- if ( $offset ) {
- @week_names = @week_names[$offset .. $#week_names, 0 .. $offset -1 ];
- }
+my $day_offset = $RT::Extension::TimeTracking::WEEK_INDEX{$first_day};
+if ( $day_offset ) {
+ @week_names = @week_names[$day_offset .. $#week_names, 0 .. $day_offset -1 ];
}
for my $offset ( 0 .. 6 ) {
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 5b04459..ca87d8b 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -109,7 +109,14 @@ Tuesday, etc.) and calculates the start date for the week the date object is
in using the passed day as the first day of the week. The default
first day of the week is Monday.
-Returns an RT::Date object set to the calculated date.
+Returns:
+
+($ret, $week_start, $first_day)
+
+where $ret is true on success, false on error, $week_start is an RT::Date
+object set to the calculated date, and $first_day is a string of the first
+day of the week, either from $TimeTrackingFirstDayOfWeek or the default of
+Monday.
=cut
@@ -141,7 +148,7 @@ sub WeekStartDate {
$week_start->Set( Format => 'unix', Value => $seconds );
}
- return (1, $week_start);
+ return (1, $week_start, $first_day);
}
=head1 AUTHOR
commit 3fe3ee6746279693089f6e22740ba7022127f9fd
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Apr 3 14:54:00 2014 -0400
Module::Install update
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index ac04c79..8616d06 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.32';
+our $VERSION = '0.33';
use FindBin;
use File::Glob ();
@@ -88,6 +88,11 @@ sub RTx {
."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
$path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
foreach @DIRS;
+
+ # Copy RT 4.2.0 static files into NoAuth; insufficient for
+ # images, but good enough for css and js.
+ $path{static} = "$path{html}/NoAuth/"
+ unless $RT::StaticPath;
} else {
foreach ( @DIRS ) {
no strict 'refs';
@@ -136,7 +141,9 @@ install ::
$has_etc{acl}++;
}
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
- if ( -d 'etc/upgrade/' ) { $has_etc{upgrade}++; }
+ if ( grep { /\d+\.\d+\.\d+.*$/ } glob('etc/upgrade/*.*.*') ) {
+ $has_etc{upgrade}++;
+ }
$self->postamble("$postamble\n");
unless ( $subdirs{'lib'} ) {
@@ -174,46 +181,50 @@ install ::
}
}
-# 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;
+ _load_rt_handle();
+ my @sorted = sort RT::Handle::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";
+ die "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ }
+}
+
+sub rt_too_new {
+ my ($self,$version,$msg) = @_;
+ $msg ||= "Your version %s is too new, this extension requires a release of RT older than %s\n";
+
+ _load_rt_handle();
+ my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION;
+
+ if ($sorted[0] eq $version) {
+ die sprintf($msg,$RT::VERSION,$version);
+ }
+}
+
+# RT::Handle runs FinalizeDatabaseType which calls RT->Config->Get
+# On 3.8, this dies. On 4.0/4.2 ->Config transparently runs LoadConfig.
+# LoadConfig requires being able to read RT_SiteConfig.pm (root) so we'd
+# like to avoid pushing that on users.
+# Fake up just enough Config to let FinalizeDatabaseType finish, and
+# anyone later calling LoadConfig will overwrite our shenanigans.
+sub _load_rt_handle {
+ unless ($RT::Config) {
+ require RT::Config;
+ $RT::Config = RT::Config->new;
+ RT->Config->Set('DatabaseType','mysql');
}
+ require RT::Handle;
}
1;
__END__
-#line 336
+#line 367
commit 7200e80c570326ff7c90f284cf05b6802c3f728a
Author: sunnavy <sunnavy at bestpractical.com>
Date: Wed Feb 25 21:48:49 2015 +0800
make sure Time::ParseDate is loaded
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index ca87d8b..38d85c6 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -143,6 +143,7 @@ sub WeekStartDate {
}
else{
# Calculate date of first day of the week
+ require Time::ParseDate;
my $seconds = Time::ParseDate::parsedate("last $first_day",
NOW => $date->Unix );
$week_start->Set( Format => 'unix', Value => $seconds );
commit 2fc226fba8b1bcb2d6139971a9741115e72c77cb
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Feb 26 21:49:52 2015 +0800
it's logically wrong to group by ObjectId
I added it initially to get a list of tickets which have been worked on a
specified day. in current code we are searching tickets been worked during a
week and if a ticket has been worked on multiple days, we want to show it on
_each_ day.
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index ebc9c78..97c46af 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -318,7 +318,6 @@ $activity_txns->Limit( FIELD => 'Created', OPERATOR => '<', VALUE => $week_end-
$activity_txns->Limit( FIELD => 'Type', VALUE => 'Create' );
$activity_txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
$activity_txns->Limit( FIELD => 'Type', VALUE => 'Comment' );
-$activity_txns->GroupByCols( { FIELD => 'ObjectId' } );
my @ticket_ids;
while ( my $txn = $activity_txns->Next ) {
my $ticket = $txn->Object;
commit fea724ae4f5678d27c5216b6ec5e41fc8b16050e
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Feb 26 23:47:14 2015 +0800
use different UpdateTimeWorked fields for tickets in one form
in 9820915, the change of "Move per-ticket save button to a single day button"
results in multiple id/UpdateTimeWorked inputs in one form when there are
multiple tickets on the day, sadly the process code hasn't been updated.
(so there will be an error of "Could not load ticket ARRAY(0x8118bb030)")
let's use a unique input name for each ticket to make it more clearly.
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 97c46af..4693dc9 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -77,9 +77,8 @@ input#Date {
% }
<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
<td class="collection-as-table">
- <input name="id" type="hidden" value=<% $ticket->id %> />
<& /Elements/EditTimeValue,
- Name => "UpdateTimeWorked",
+ Name => 'Ticket-' . $ticket->id . "-UpdateTimeWorked",
Default => '',
InUnits => $DefaultTimeUnits || 'minutes',
&>
@@ -152,26 +151,31 @@ $date_cf->LoadByName( Name => 'Worked Date', LookupType => 'RT::Queue-RT::Ticket
my $actor_cf = RT::CustomField->new($user);
$actor_cf->LoadByName( Name => 'Actor', LookupType => 'RT::Queue-RT::Ticket-RT::Transaction');
-if ( defined $ARGS{'UpdateTimeWorked'} ) {
- RT::Interface::Web::PreprocessTimeUpdates(\%ARGS);
+my %worked = (
+ $ARGS{id} && $ARGS{'UpdateTimeWorked'} ? ( $ARGS{id} => $ARGS{'UpdateTimeWorked'} ) : (),
+ map { $ARGS{$_} && /^Ticket-(\d+)-UpdateTimeWorked$/ ? ( $1, $ARGS{$_} ) : () } keys %ARGS
+);
+
+RT::Interface::Web::PreprocessTimeUpdates(\%ARGS);
+for my $id ( sort { $a <=> $b } keys %worked ) {
my $ticket = RT::Ticket->new( $user );
- $ticket->Load($ARGS{id});
+ $ticket->Load($id);
if ( $ticket->id ) {
- my ( $val, $msg, $txn ) = $ticket->SetTimeWorked( $ticket->TimeWorked + $ARGS{'UpdateTimeWorked'} );
+ my ( $val, $msg, $txn ) = $ticket->SetTimeWorked( $ticket->TimeWorked + $worked{$id} );
push( @results, $msg );
$txn->UpdateCustomFields( %ARGS ) if $txn;
}
else {
push @results, loc("Could not load ticket $ARGS{id}");
}
-
- MaybeRedirectForResults(
- Actions => \@results,
- Arguments => { Date => $Date, DefaultTimeUnits => $DefaultTimeUnits, User => $User },
- );
}
+MaybeRedirectForResults(
+ Actions => \@results,
+ Arguments => { Date => $Date, DefaultTimeUnits => $DefaultTimeUnits, User => $User },
+);
+
# Do we need to load a CF for display?
my $display_cf;
if ( $display_cf = RT->Config->Get('TimeTrackingDisplayCF') ){
commit 7a8ada15949e83e43ef7ffb42c30cc4bc62253e1
Author: sunnavy <sunnavy at bestpractical.com>
Date: Fri Feb 27 00:25:11 2015 +0800
prefix ticket id to each result item to make it more distinguishable
especially considering we can add time to multiple tickets at the same time
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 4693dc9..2a254c6 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -163,7 +163,7 @@ for my $id ( sort { $a <=> $b } keys %worked ) {
if ( $ticket->id ) {
my ( $val, $msg, $txn ) = $ticket->SetTimeWorked( $ticket->TimeWorked + $worked{$id} );
- push( @results, $msg );
+ push( @results, "#$id: " . $msg );
$txn->UpdateCustomFields( %ARGS ) if $txn;
}
else {
commit dff48c413f836a7a0fc609ff55cd3d83869faf1d
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Apr 15 15:02:21 2015 -0400
Adjust the patch to skip 0-value or empty TimeWorked values
diff --git a/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch b/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
index 3d1262d..0cc0cd8 100644
--- a/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
+++ b/etc/0001-handle-txn-cfs-on-ticket-creation-and-updates-with-U.patch
@@ -25,7 +25,7 @@ index 2dd0fd1..4a73d3b 100644
ARGSRef => $ARGSRef,
);
-+ if ( defined $ARGSRef->{'TimeWorked'} ) {
++ if ( $ARGSRef->{'TimeWorked'} ) {
+ my ( $val, $msg, $txn ) = $TicketObj->SetTimeWorked( $ARGSRef->{'TimeWorked'} );
+ push( @results, $msg );
+ $txn->UpdateCustomFields( %$ARGSRef) if $txn;
commit c8a824212dbf122402ad0292d7966f22e780acc0
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Apr 15 15:08:41 2015 -0400
Updated packaging
diff --git a/Changes b/Changes
index ca395c3..8311413 100644
--- a/Changes
+++ b/Changes
@@ -1,17 +1,25 @@
Revision history for RT-Extension-TimeTracking
-0.04 2014-03-13
- * Add $TimeTrackingDisplayCF feature
+0.05 2015-04-15
+ - Updated layout for "My Week" page
+ - Stop grouping "My Week" results by ticket id
+ - Prefix results on "My Week" with ticket id
+ - Prevent spurious "That is already the current value" messages on Basics
+ - Packaging updates
-0.03 2014-03-12
- * Fix daylight savings time issue
- * Fix week end offset
- * Fix weekday name in timesheet when custom first day of week selected
+0.04 2014-03-13
+ - Add $TimeTrackingDisplayCF feature
-0.02 2014-03-07
- * Use the user's timezone to set the default date for entering time
- * Refactor first day of week handling to avoid flipping to the next
- week on the last day of the week
+0.03 2014-03-12
+ - Fix daylight savings time issue
+ - Fix week end offset
+ - Fix weekday name in timesheet when custom first day of week selected
+
+0.02 2014-03-07
+ - Use the user's timezone to set the default date for entering time
+ - Refactor first day of week handling to avoid flipping to the next week
+ on the last day of the week
+
+0.01 2013-12-19
+ - Initial release.
-0.01 2013-12-19
- * Initial release.
diff --git a/MANIFEST b/MANIFEST
index c388e6f..8dd82c3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -19,11 +19,13 @@ inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/RTx.pm
-inc/Module/Install/RTx/Factory.pm
+inc/Module/Install/RTx/Runtime.pm
inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
+inc/YAML/Tiny.pm
lib/RT/Extension/TimeTracking.pm
+lib/RT/Extension/TimeTracking/Test.pm
lib/RT/Extension/TimeTracking/Test.pm.in
Makefile.PL
MANIFEST This list of files
diff --git a/META.yml b/META.yml
index e9c2424..f9683c6 100644
--- a/META.yml
+++ b/META.yml
@@ -1,15 +1,15 @@
---
-abstract: 'RT Extension-TimeTracking Extension'
+abstract: 'RT-Extension-TimeTracking Extension'
author:
- - 'sunnavy <sunnavy at bestpractical.com>'
+ - 'Best Practical Solutions, LLC <modules at bestpractical.com>'
build_requires:
- ExtUtils::MakeMaker: 6.36
+ ExtUtils::MakeMaker: 6.59
configure_requires:
- ExtUtils::MakeMaker: 6.36
+ ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 1
-generated_by: 'Module::Install version 1.06'
-license: gplv2
+generated_by: 'Module::Install version 1.14'
+license: gpl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
@@ -21,6 +21,10 @@ no_index:
- inc
- static
- xt
+requires:
+ perl: 5.10.1
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.04
+version: '0.04'
+x_module_install_rtx_version: '0.37'
+x_requires_rt: 4.2.0
diff --git a/Makefile.PL b/Makefile.PL
index 9041e42..a032a51 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,9 +1,8 @@
use inc::Module::Install;
RTx 'RT-Extension-TimeTracking';
-all_from 'lib/RT/Extension/TimeTracking.pm';
-readme_from 'lib/RT/Extension/TimeTracking.pm';
-license 'gplv2';
+
+requires_rt '4.2.0';
my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
diff --git a/README b/README
index db37094..0515aa6 100644
--- a/README
+++ b/README
@@ -5,12 +5,12 @@ RT VERSION
Works with RT 4.2
INSTALLATION
- "perl Makefile.PL"
- "make"
- "make install"
+ perl Makefile.PL
+ make
+ make install
May need root permissions
- "make initdb"
+ make initdb
Only run this the first time you install this module.
If you run this twice, you may end up with duplicate data in your
@@ -27,9 +27,7 @@ INSTALLATION
Edit your /opt/rt4/etc/RT_SiteConfig.pm
Add this line:
- Set(@Plugins, qw(RT::Extension::TimeTracking));
-
- or add "RT::Extension::TimeTracking" to your existing @Plugins line.
+ Plugin('RT::Extension::TimeTracking');
Clear your mason cache
rm -rf /opt/rt4/var/mason_data/obj
@@ -69,18 +67,15 @@ METHODS
the default of Monday.
AUTHOR
- sunnavy <sunnavy at bestpractical.com>
+ Best Practical Solutions, LLC <modules at bestpractical.com>
BUGS
- All bugs should be reported via email to
- bug-RT-Extension-TimeTracking at rt.cpan.org
- <mailto:bug-RT-Extension-TimeTracking at rt.cpan.org> or via the web at
- rt.cpan.org
- <http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-TimeTrack
- ing>.
-
-LICENSE AND COPYRIGHT
- Copyright (c) 2013, Best Practical Solutions, LLC.
+ Since this module is not on CPAN, bugs should be reported via
+ <modules at bestpractical.com>, or via standard BPS support contract
+ channels.
+
+COPYRIGHT
+ This extension is Copyright (C) 2013-2015 Best Practical Solutions, LLC.
This is free software, licensed under:
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index aa7aa92..cd93d14 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -8,7 +8,7 @@ use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
}
# special map on pre-defined feature sets
@@ -115,7 +115,7 @@ sub import {
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
$Config = [];
@@ -166,7 +166,7 @@ sub import {
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
- if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
@@ -345,22 +345,26 @@ sub install {
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 ) ) {
+ my ( @modules, @installed, @modules_to_upgrade );
+ 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;
- }
- }
+ # grep out those already installed
+ if (_version_cmp(_version_of($pkg), $ver) >= 0) {
+ push @installed, $pkg;
+ if ($UpgradeDeps) {
+ push @modules_to_upgrade, $pkg, $ver;
+ }
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
- if ($UpgradeDeps) {
- push @modules, @installed;
- @installed = ();
- }
+ if ($UpgradeDeps) {
+ push @modules, @modules_to_upgrade;
+ @installed = ();
+ @modules_to_upgrade = ();
+ }
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
@@ -611,7 +615,7 @@ sub _under_cpan {
require Cwd;
require File::Spec;
- my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cwd = File::Spec->canonpath( Cwd::getcwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
@@ -927,4 +931,4 @@ END_MAKE
__END__
-#line 1193
+#line 1197
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 4ecf46b..ff767fa 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,7 +17,7 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-use 5.005;
+use 5.006;
use strict 'vars';
use Cwd ();
use File::Find ();
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.06';
+ $VERSION = '1.14';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -156,10 +156,10 @@ END_DIE
sub autoload {
my $self = shift;
my $who = $self->_caller;
- my $cwd = Cwd::cwd();
+ my $cwd = Cwd::getcwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
- my $pwd = Cwd::cwd();
+ my $pwd = Cwd::getcwd();
if ( my $code = $sym->{$pwd} ) {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
@@ -239,7 +239,7 @@ sub new {
# 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 ) {
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
@@ -338,7 +338,7 @@ sub find_extensions {
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
- foreach ( split //, $content ) {
+ foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -378,6 +378,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -386,6 +387,7 @@ END_NEW
sub _read {
local *FH;
open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
@@ -416,6 +418,7 @@ eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -425,6 +428,7 @@ END_NEW
sub _write {
local *FH;
open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
@@ -434,7 +438,7 @@ END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
-sub _version ($) {
+sub _version {
my $s = shift || 0;
my $d =()= $s =~ /(\.)/g;
if ( $d >= 2 ) {
@@ -450,12 +454,12 @@ sub _version ($) {
return $l + 0;
}
-sub _cmp ($$) {
+sub _cmp {
_version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
-sub _CLASS ($) {
+sub _CLASS {
(
defined $_[0]
and
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index 6efe4fe..475303e 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 802844a..4206347 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 22167b8..9929b1b 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -8,7 +8,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index bee0c4f..3d8de76 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 8310e4c..f274f87 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 7052f36..66993af 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -133,7 +133,7 @@ sub makemaker_args {
return $args;
}
-# For mm args that take multiple space-seperated args,
+# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
my $self = shift;
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 58430f3..e547fa0 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -347,7 +347,7 @@ sub name_from {
^ \s*
package \s*
([\w:]+)
- \s* ;
+ [\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
@@ -705,7 +705,7 @@ sub _write_mymeta_data {
my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
my $meta = $yaml[0];
- # Overwrite the non-configure dependency hashs
+ # Overwrite the non-configure dependency hashes
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 8616d06..97acf77 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.33';
+our $VERSION = '0.37';
use FindBin;
use File::Glob ();
@@ -18,100 +18,79 @@ my @DIRS = qw(etc lib html static bin sbin po var);
my @INDEX_DIRS = qw(lib bin sbin);
sub RTx {
- my ( $self, $name ) = @_;
+ my ( $self, $name, $extra_args ) = @_;
+ $extra_args ||= {};
- my $original_name = $name;
- my $RTx = 'RTx';
- $RTx = $1 if $name =~ s/^(\w+)-//;
+ # Set up names
my $fname = $name;
$fname =~ s!-!/!g;
- $self->name("$RTx-$name")
+ $self->name( $name )
unless $self->name;
- $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ $self->all_from( "lib/$fname.pm" )
unless $self->version;
- $self->abstract("RT $name Extension")
+ $self->abstract("$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";
- }
+ unless ( $extra_args->{no_readme_generation} ) {
+ $self->readme_from( "lib/$fname.pm",
+ { options => [ quotes => "none" ] } );
+ }
+ $self->add_metadata("x_module_install_rtx_version", $VERSION );
+
+ # Try to find RT.pm
+ my @prefixes = qw( /opt /usr/local /home /usr /sw /usr/share/request-tracker4);
+ $ENV{RTHOME} =~ s{/RT\.pm$}{} if defined $ENV{RTHOME};
+ $ENV{RTHOME} =~ s{/lib/?$}{} if defined $ENV{RTHOME};
+ my @try = $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : ();
+ while (1) {
+ my @look = @INC;
+ unshift @look, grep {defined and -d $_} @try;
+ push @look, grep {defined and -d $_}
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/lib" ) } @prefixes;
+ last if eval {local @INC = @look; require RT; $RT::LocalLibPath};
+
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @look\n";
+ my $given = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $given =~ s{/RT\.pm$}{};
+ $given =~ s{/lib/?$}{};
+ @try = ($given, "$given/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::LocalStaticPath ||= $RT::StaticPath;
- $RT::LocalLibPath ||= "$RT::LocalPath/lib";
- my $with_subdirs = $ENV{WITH_SUBDIRS};
- @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
- @ARGV;
+ my $local_lib_path = $RT::LocalLibPath;
+ unshift @INC, $local_lib_path;
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ unshift @INC, $lib_path;
- 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;
+ # Set a baseline minimum version
+ unless ( $extra_args->{deprecated_rt} ) {
+ $self->requires_rt('4.0.0');
}
- # 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
+ # Installation locations
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;
-
- # Copy RT 4.2.0 static files into NoAuth; insufficient for
- # images, but good enough for css and js.
- $path{static} = "$path{html}/NoAuth/"
- unless $RT::StaticPath;
- } else {
- foreach ( @DIRS ) {
- no strict 'refs';
- my $varname = "RT::Local" . ucfirst($_) . "Path";
- $path{$_} = ${$varname} || "$RT::LocalPath/$_";
- }
+ $path{$_} = $RT::LocalPluginPath . "/$name/$_"
+ foreach @DIRS;
- $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
- }
+ # Copy RT 4.2.0 static files into NoAuth; insufficient for
+ # images, but good enough for css and js.
+ $path{static} = "$path{html}/NoAuth/"
+ unless $RT::StaticPath;
+
+ # Delete the ones we don't need
+ delete $path{$_} for grep {not -d "$FindBin::Bin/$_"} keys %path;
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;
+ sort keys %path;
- print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+ printf "%-10s => %s\n", $_, $path{$_} for sort keys %path;
- if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin etc) ) {
my @po = map { ( -o => $_ ) }
grep -f,
File::Glob::bsd_glob("po/*.po");
@@ -121,12 +100,15 @@ lexicons ::
.
}
+ $self->include('Module::Install::RTx::Runtime') if $self->admin;
+ $self->include_deps( 'YAML::Tiny', 0 ) if $self->admin;
my $postamble = << ".";
install ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxPlugin()"
\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
.
- if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ if ( $path{var} and -d $RT::MasonDataDir ) {
my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
$postamble .= << ".";
\t\$(NOECHO) chown -R $uid:$gid $path{var}
@@ -146,11 +128,11 @@ install ::
}
$self->postamble("$postamble\n");
- unless ( $subdirs{'lib'} ) {
- $self->makemaker_args( PM => { "" => "" }, );
- } else {
+ if ( $path{lib} ) {
$self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
$self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+ } else {
+ $self->makemaker_args( PM => { "" => "" }, );
}
$self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
@@ -158,47 +140,96 @@ install ::
$self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
if (%has_etc) {
- $self->load('RTxInitDB');
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(schema \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(acl \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(insert \$(NAME) \$(VERSION)))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
if ($has_etc{upgrade}) {
print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
- my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+ my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
$self->postamble("upgrade-database ::\n$upgradedb\n");
$self->postamble("upgradedb ::\n$upgradedb\n");
}
}
+
}
sub requires_rt {
my ($self,$version) = @_;
+ _load_rt_handle();
+
+ if ($self->is_admin) {
+ $self->add_metadata("x_requires_rt", $version);
+ my @sorted = sort RT::Handle::cmp_version $version,'4.0.0';
+ $self->perl_version('5.008003') if $sorted[0] eq '4.0.0'
+ and (not $self->perl_version or '5.008003' > $self->perl_version);
+ @sorted = sort RT::Handle::cmp_version $version,'4.2.0';
+ $self->perl_version('5.010001') if $sorted[0] eq '4.2.0'
+ and (not $self->perl_version or '5.010001' > $self->perl_version);
+ }
+
# if we're exactly the same version as what we want, silently return
return if ($version eq $RT::VERSION);
- _load_rt_handle();
my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION;
if ($sorted[-1] eq $version) {
- # should we die?
- die "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ die <<"EOT";
+
+**** Error: This extension requires RT $version. Your installed version
+ of RT ($RT::VERSION) is too old.
+
+EOT
+ }
+}
+
+sub requires_rt_plugin {
+ my $self = shift;
+ my ( $plugin ) = @_;
+
+ if ($self->is_admin) {
+ my $plugins = $self->Meta->{values}{"x_requires_rt_plugins"} || [];
+ push @{$plugins}, $plugin;
+ $self->add_metadata("x_requires_rt_plugins", $plugins);
}
+
+ my $path = $plugin;
+ $path =~ s{\:\:}{-}g;
+ $path = "$RT::LocalPluginPath/$path/lib";
+ if ( -e $path ) {
+ unshift @INC, $path;
+ } else {
+ my $name = $self->name;
+ warn <<"EOT";
+
+**** Warning: $name requires that the $plugin plugin be installed and
+ enabled; it does not appear to be installed.
+
+EOT
+ }
+ $self->requires(@_);
}
sub rt_too_new {
my ($self,$version,$msg) = @_;
- $msg ||= "Your version %s is too new, this extension requires a release of RT older than %s\n";
+ my $name = $self->name;
+ $msg ||= <<EOT;
+
+**** Error: Your installed version of RT (%s) is too new; this extension
+ only works with versions older than %s.
+
+EOT
+ $self->add_metadata("x_rt_too_new", $version) if $self->is_admin;
_load_rt_handle();
my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION;
@@ -227,4 +258,4 @@ sub _load_rt_handle {
__END__
-#line 367
+#line 390
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
deleted file mode 100644
index 6776688..0000000
--- a/inc/Module/Install/RTx/Factory.pm
+++ /dev/null
@@ -1,53 +0,0 @@
-#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, $name, $version) = @_;
-
- 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();
-
- require RT::System;
-
- 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,
- ($action eq 'upgrade' ? () : ("--datadir" => "etc")),
- (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
- "--dba" => $RT::DatabaseAdmin || $RT::DatabaseUser,
- "--prompt-for-dba-password" => '',
- (RT::System->can('AddUpgradeHistory') ? ("--package" => $name, "--ext-version" => $version) : ()),
- );
- # If we're upgrading against an RT which isn't at least 4.2 (has
- # AddUpgradeHistory) then pass --package. Upgrades against later RT
- # releases will pick up --package from AddUpgradeHistory.
- if ($action eq 'upgrade' and
- not RT::System->can('AddUpgradeHistory')) {
- push @args, "--package" => $name;
- }
-
- print "$^X @args\n";
- (system($^X, @args) == 0) or die "...returned with error: $?\n";
-}
-
-1;
diff --git a/inc/Module/Install/RTx/Runtime.pm b/inc/Module/Install/RTx/Runtime.pm
new file mode 100644
index 0000000..937949f
--- /dev/null
+++ b/inc/Module/Install/RTx/Runtime.pm
@@ -0,0 +1,79 @@
+#line 1
+package Module::Install::RTx::Runtime;
+
+use base 'Exporter';
+our @EXPORT = qw/RTxDatabase RTxPlugin/;
+
+use strict;
+use File::Basename ();
+
+sub _rt_runtime_load {
+ require RT;
+
+ eval { RT::LoadConfig(); };
+ if (my $err = $@) {
+ die $err unless $err =~ /^RT couldn't load RT config file/m;
+ my $warn = <<EOT;
+This usually means that your current user cannot read the file. You
+will likely need to run this installation step as root, or some user
+with more permissions.
+EOT
+ $err =~ s/This usually means.*/$warn/s;
+ die $err;
+ }
+}
+
+sub RTxDatabase {
+ my ($action, $name, $version) = @_;
+
+ _rt_runtime_load();
+
+ require RT::System;
+ my $has_upgrade = RT::System->can('AddUpgradeHistory');
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ my @args = (
+ "-Ilib",
+ "-I$RT::LocalLibPath",
+ "-I$lib_path",
+ "$RT::SbinPath/rt-setup-database",
+ "--action" => $action,
+ ($action eq 'upgrade' ? () : ("--datadir" => "etc")),
+ (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
+ "--dba" => $RT::DatabaseAdmin || $RT::DatabaseUser,
+ "--prompt-for-dba-password" => '',
+ ($has_upgrade ? ("--package" => $name, "--ext-version" => $version) : ()),
+ );
+ # If we're upgrading against an RT which isn't at least 4.2 (has
+ # AddUpgradeHistory) then pass --package. Upgrades against later RT
+ # releases will pick up --package from AddUpgradeHistory.
+ if ($action eq 'upgrade' and not $has_upgrade) {
+ push @args, "--package" => $name;
+ }
+
+ print "$^X @args\n";
+ (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+sub RTxPlugin {
+ my ($name) = @_;
+
+ _rt_runtime_load();
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+ my $name = $data->{name};
+
+ my @enabled = RT->Config->Get('Plugins');
+ for my $required (@{$data->{x_requires_rt_plugins} || []}) {
+ next if grep {$required eq $_} @enabled;
+
+ warn <<"EOT";
+
+**** Warning: $name requires that the $required plugin be installed and
+ enabled; it is not currently in \@Plugins.
+
+EOT
+ }
+}
+
+1;
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index eeaa3fe..9706e5f 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 85d8018..dbedc00 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.06';
+ $VERSION = '1.14';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
diff --git a/inc/YAML/Tiny.pm b/inc/YAML/Tiny.pm
new file mode 100644
index 0000000..8da7cd1
--- /dev/null
+++ b/inc/YAML/Tiny.pm
@@ -0,0 +1,875 @@
+#line 1
+use 5.008001; # sane UTF-8 support
+use strict;
+use warnings;
+package YAML::Tiny;
+# git description: v1.63-12-g5dd832a
+$YAML::Tiny::VERSION = '1.64';
+# XXX-INGY is 5.8.1 too old/broken for utf8?
+# XXX-XDG Lancaster consensus was that it was sufficient until
+# proven otherwise
+
+
+#####################################################################
+# The YAML::Tiny API.
+#
+# These are the currently documented API functions/methods and
+# exports:
+
+use Exporter;
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{ Load Dump };
+our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+###
+# Functional/Export API:
+
+sub Dump {
+ return YAML::Tiny->new(@_)->_dump_string;
+}
+
+# XXX-INGY Returning last document seems a bad behavior.
+# XXX-XDG I think first would seem more natural, but I don't know
+# that it's worth changing now
+sub Load {
+ my $self = YAML::Tiny->_load_string(@_);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # To match YAML.pm, return the last document
+ return $self->[-1];
+ }
+}
+
+# XXX-INGY Do we really need freeze and thaw?
+# XXX-XDG I don't think so. I'd support deprecating them.
+BEGIN {
+ *freeze = \&Dump;
+ *thaw = \&Load;
+}
+
+sub DumpFile {
+ my $file = shift;
+ return YAML::Tiny->new(@_)->_dump_file($file);
+}
+
+sub LoadFile {
+ my $file = shift;
+ my $self = YAML::Tiny->_load_file($file);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
+ }
+}
+
+
+###
+# Object Oriented API:
+
+# Create an empty YAML::Tiny object
+# XXX-INGY Why do we use ARRAY object?
+# NOTE: I get it now, but I think it's confusing and not needed.
+# Will change it on a branch later, for review.
+#
+# XXX-XDG I don't support changing it yet. It's a very well-documented
+# "API" of YAML::Tiny. I'd support deprecating it, but Adam suggested
+# we not change it until YAML.pm's own OO API is established so that
+# users only have one API change to digest, not two
+sub new {
+ my $class = shift;
+ bless [ @_ ], $class;
+}
+
+# XXX-INGY It probably doesn't matter, and it's probably too late to
+# change, but 'read/write' are the wrong names. Read and Write
+# are actions that take data from storage to memory
+# characters/strings. These take the data to/from storage to native
+# Perl objects, which the terms dump and load are meant. As long as
+# this is a legacy quirk to YAML::Tiny it's ok, but I'd prefer not
+# to add new {read,write}_* methods to this API.
+
+sub read_string {
+ my $self = shift;
+ $self->_load_string(@_);
+}
+
+sub write_string {
+ my $self = shift;
+ $self->_dump_string(@_);
+}
+
+sub read {
+ my $self = shift;
+ $self->_load_file(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->_dump_file(@_);
+}
+
+
+
+
+#####################################################################
+# Constants
+
+# Printed form of the unprintable characters in the lowest range
+# of ASCII characters, listed by ASCII ordinal position.
+my @UNPRINTABLE = qw(
+ 0 x01 x02 x03 x04 x05 x06 a
+ b t n v f r x0E x0F
+ x10 x11 x12 x13 x14 x15 x16 x17
+ x18 x19 x1A e x1C x1D x1E x1F
+);
+
+# Printable characters for escapes
+my %UNESCAPES = (
+ 0 => "\x00", z => "\x00", N => "\x85",
+ a => "\x07", b => "\x08", t => "\x09",
+ n => "\x0a", v => "\x0b", f => "\x0c",
+ r => "\x0d", e => "\x1b", '\\' => '\\',
+);
+
+# XXX-INGY
+# I(ngy) need to decide if these values should be quoted in
+# YAML::Tiny or not. Probably yes.
+
+# These 3 values have special meaning when unquoted and using the
+# default YAML schema. They need quotes if they are strings.
+my %QUOTE = map { $_ => 1 } qw{
+ null true false
+};
+
+# The commented out form is simpler, but overloaded the Perl regex
+# engine due to recursion and backtracking problems on strings
+# larger than 32,000ish characters. Keep it for reference purposes.
+# qr/\"((?:\\.|[^\"])*)\"/
+my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
+my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
+# unquoted re gets trailing space that needs to be stripped
+my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;
+my $re_trailing_comment = qr/(?:\s+\#.*)?/;
+my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
+
+
+
+
+
+#####################################################################
+# YAML::Tiny Implementation.
+#
+# These are the private methods that do all the work. They may change
+# at any time.
+
+
+###
+# Loader functions:
+
+# Create an object from a file
+sub _load_file {
+ my $class = ref $_[0] ? ref shift : shift;
+
+ # Check the file
+ my $file = shift or $class->_error( 'You did not specify a file name' );
+ $class->_error( "File '$file' does not exist" )
+ unless -e $file;
+ $class->_error( "'$file' is a directory, not a file" )
+ unless -f _;
+ $class->_error( "Insufficient permissions to read '$file'" )
+ unless -r _;
+
+ # Open unbuffered with strict UTF-8 decoding and no translation layers
+ open( my $fh, "<:unix:encoding(UTF-8)", $file );
+ unless ( $fh ) {
+ $class->_error("Failed to open file '$file': $!");
+ }
+
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ flock( $fh, Fcntl::LOCK_SH() )
+ or warn "Couldn't lock '$file' for reading: $!";
+ }
+
+ # slurp the contents
+ my $contents = eval {
+ use warnings FATAL => 'utf8';
+ local $/;
+ <$fh>
+ };
+ if ( my $err = $@ ) {
+ $class->_error("Error reading from file '$file': $err");
+ }
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $class->_error("Failed to close file '$file': $!");
+ }
+
+ $class->_load_string( $contents );
+}
+
+# Create an object from a string
+sub _load_string {
+ my $class = ref $_[0] ? ref shift : shift;
+ my $self = bless [], $class;
+ my $string = $_[0];
+ eval {
+ unless ( defined $string ) {
+ die \"Did not provide a string to load";
+ }
+
+ # Check if Perl has it marked as characters, but it's internally
+ # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
+ if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
+ die \<<'...';
+Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
+Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
+...
+ }
+
+ # Ensure Unicode character semantics, even for 0x80-0xff
+ utf8::upgrade($string);
+
+ # Check for and strip any leading UTF-8 BOM
+ $string =~ s/^\x{FEFF}//;
+
+ # Check for some special cases
+ return $self unless length $string;
+
+ # Split the file into lines
+ my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
+ split /(?:\015{1,2}\012|\015|\012)/, $string;
+
+ # Strip the initial YAML header
+ @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
+
+ # A nibbling parser
+ my $in_document = 0;
+ while ( @lines ) {
+ # Do we have a document header?
+ if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
+ # Handle scalar documents
+ shift @lines;
+ if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
+ push @$self,
+ $self->_load_scalar( "$1", [ undef ], \@lines );
+ next;
+ }
+ $in_document = 1;
+ }
+
+ if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
+ # A naked document
+ push @$self, undef;
+ while ( @lines and $lines[0] !~ /^---/ ) {
+ shift @lines;
+ }
+ $in_document = 0;
+
+ # XXX The final '-+$' is to look for -- which ends up being an
+ # error later.
+ } elsif ( ! $in_document && @$self ) {
+ # only the first document can be explicit
+ die \"YAML::Tiny failed to classify the line '$lines[0]'";
+ } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
+ # An array at the root
+ my $document = [ ];
+ push @$self, $document;
+ $self->_load_array( $document, [ 0 ], \@lines );
+
+ } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
+ # A hash at the root
+ my $document = { };
+ push @$self, $document;
+ $self->_load_hash( $document, [ length($1) ], \@lines );
+
+ } else {
+ # Shouldn't get here. @lines have whitespace-only lines
+ # stripped, and previous match is a line with any
+ # non-whitespace. So this clause should only be reachable via
+ # a perlbug where \s is not symmetric with \S
+
+ # uncoverable statement
+ die \"YAML::Tiny failed to classify the line '$lines[0]'";
+ }
+ }
+ };
+ my $err = $@;
+ if ( ref $err eq 'SCALAR' ) {
+ $self->_error(${$err});
+ } elsif ( $err ) {
+ $self->_error($err);
+ }
+
+ return $self;
+}
+
+sub _unquote_single {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+}
+
+sub _unquote_double {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\\"/"/g;
+ $string =~
+ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
+ {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
+ return $string;
+}
+
+# Load a YAML scalar string to the actual Perl scalar
+sub _load_scalar {
+ my ($self, $string, $indent, $lines) = @_;
+
+ # Trim trailing whitespace
+ $string =~ s/\s*\z//;
+
+ # Explitic null/undef
+ return undef if $string eq '~';
+
+ # Single quote
+ if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_single($1);
+ }
+
+ # Double quote.
+ if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_double($1);
+ }
+
+ # Special cases
+ if ( $string =~ /^[\'\"!&]/ ) {
+ die \"YAML::Tiny does not support a feature in line '$string'";
+ }
+ return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
+ return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
+
+ # Regular unquoted string
+ if ( $string !~ /^[>|]/ ) {
+ die \"YAML::Tiny found illegal characters in plain scalar: '$string'"
+ if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
+ $string =~ /:(?:\s|$)/;
+ $string =~ s/\s+#.*\z//;
+ return $string;
+ }
+
+ # Error
+ die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
+
+ # Check the indent depth
+ $lines->[0] =~ /^(\s*)/;
+ $indent->[-1] = length("$1");
+ if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ # Pull the lines
+ my @multiline = ();
+ while ( @$lines ) {
+ $lines->[0] =~ /^(\s*)/;
+ last unless length($1) >= $indent->[-1];
+ push @multiline, substr(shift(@$lines), length($1));
+ }
+
+ my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
+ my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
+ return join( $j, @multiline ) . $t;
+}
+
+# Load an array
+sub _load_array {
+ my ($self, $array, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
+ # Inline nested hash
+ my $indent2 = length("$1");
+ $lines->[0] =~ s/-/ /;
+ push @$array, { };
+ $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+
+ } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
+ shift @$lines;
+ unless ( @$lines ) {
+ push @$array, undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)\-/ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] == $indent2 ) {
+ # Null array entry
+ push @$array, undef;
+ } else {
+ # Naked indenter
+ push @$array, [ ];
+ $self->_load_array(
+ $array->[-1], [ @$indent, $indent2 ], $lines
+ );
+ }
+
+ } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+ push @$array, { };
+ $self->_load_hash(
+ $array->[-1], [ @$indent, length("$1") ], $lines
+ );
+
+ } else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, $self->_load_scalar(
+ "$2", [ @$indent, undef ], $lines
+ );
+
+ } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
+ # This is probably a structure like the following...
+ # ---
+ # foo:
+ # - list
+ # bar: value
+ #
+ # ... so lets return and let the hash parser handle it
+ return 1;
+
+ } else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+ }
+
+ return 1;
+}
+
+# Load a hash
+sub _load_hash {
+ my ($self, $hash, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ # Find the key
+ my $key;
+
+ # Quoted keys
+ if ( $lines->[0] =~
+ s/^\s*$re_capture_single_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_single($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_double_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_double($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_unquoted_key$re_key_value_separator//
+ ) {
+ $key = $1;
+ $key =~ s/\s+$//;
+ }
+ elsif ( $lines->[0] =~ /^\s*\?/ ) {
+ die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
+ }
+ else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+
+ if ( exists $hash->{$key} ) {
+ die \"YAML::Tiny found a duplicate key '$key' in line '$lines->[0]'";
+ }
+
+ # Do we have a value?
+ if ( length $lines->[0] ) {
+ # Yes
+ $hash->{$key} = $self->_load_scalar(
+ shift(@$lines), [ @$indent, undef ], $lines
+ );
+ } else {
+ # An indent
+ shift @$lines;
+ unless ( @$lines ) {
+ $hash->{$key} = undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)-/ ) {
+ $hash->{$key} = [];
+ $self->_load_array(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
+ } elsif ( $lines->[0] =~ /^(\s*)./ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] >= $indent2 ) {
+ # Null hash entry
+ $hash->{$key} = undef;
+ } else {
+ $hash->{$key} = {};
+ $self->_load_hash(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
+ }
+ }
+ }
+ }
+
+ return 1;
+}
+
+
+###
+# Dumper functions:
+
+# Save an object to a file
+sub _dump_file {
+ my $self = shift;
+
+ require Fcntl;
+
+ # Check the file
+ my $file = shift or $self->_error( 'You did not specify a file name' );
+
+ my $fh;
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ # Open without truncation (truncate comes after lock)
+ my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
+ sysopen( $fh, $file, $flags );
+ unless ( $fh ) {
+ $self->_error("Failed to open file '$file' for writing: $!");
+ }
+
+ # Use no translation and strict UTF-8
+ binmode( $fh, ":raw:encoding(UTF-8)");
+
+ flock( $fh, Fcntl::LOCK_EX() )
+ or warn "Couldn't lock '$file' for reading: $!";
+
+ # truncate and spew contents
+ truncate $fh, 0;
+ seek $fh, 0, 0;
+ }
+ else {
+ open $fh, ">:unix:encoding(UTF-8)", $file;
+ }
+
+ # serialize and spew to the handle
+ print {$fh} $self->_dump_string;
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $self->_error("Failed to close file '$file': $!");
+ }
+
+ return 1;
+}
+
+# Save an object to a string
+sub _dump_string {
+ my $self = shift;
+ return '' unless ref $self && @$self;
+
+ # Iterate over the documents
+ my $indent = 0;
+ my @lines = ();
+
+ eval {
+ foreach my $cursor ( @$self ) {
+ push @lines, '---';
+
+ # An empty document
+ if ( ! defined $cursor ) {
+ # Do nothing
+
+ # A scalar document
+ } elsif ( ! ref $cursor ) {
+ $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
+
+ # A list at the root
+ } elsif ( ref $cursor eq 'ARRAY' ) {
+ unless ( @$cursor ) {
+ $lines[-1] .= ' []';
+ next;
+ }
+ push @lines, $self->_dump_array( $cursor, $indent, {} );
+
+ # A hash at the root
+ } elsif ( ref $cursor eq 'HASH' ) {
+ unless ( %$cursor ) {
+ $lines[-1] .= ' {}';
+ next;
+ }
+ push @lines, $self->_dump_hash( $cursor, $indent, {} );
+
+ } else {
+ die \("Cannot serialize " . ref($cursor));
+ }
+ }
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ $self->_error(${$@});
+ } elsif ( $@ ) {
+ $self->_error($@);
+ }
+
+ join '', map { "$_\n" } @lines;
+}
+
+sub _has_internal_string_value {
+ my $value = shift;
+ my $b_obj = B::svref_2object(\$value); # for round trip problem
+ return $b_obj->FLAGS & B::SVf_POK();
+}
+
+sub _dump_scalar {
+ my $string = $_[1];
+ my $is_key = $_[2];
+ # Check this before checking length or it winds up looking like a string!
+ my $has_string_flag = _has_internal_string_value($string);
+ return '~' unless defined $string;
+ return "''" unless length $string;
+ if (Scalar::Util::looks_like_number($string)) {
+ # keys and values that have been used as strings get quoted
+ if ( $is_key || $has_string_flag ) {
+ return qq['$string'];
+ }
+ else {
+ return $string;
+ }
+ }
+ if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
+ $string =~ s/\\/\\\\/g;
+ $string =~ s/"/\\"/g;
+ $string =~ s/\n/\\n/g;
+ $string =~ s/[\x85]/\\N/g;
+ $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
+ $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
+ return qq|"$string"|;
+ }
+ if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
+ $QUOTE{$string}
+ ) {
+ return "'$string'";
+ }
+ return $string;
+}
+
+sub _dump_array {
+ my ($self, $array, $indent, $seen) = @_;
+ if ( $seen->{refaddr($array)}++ ) {
+ die \"YAML::Tiny does not support circular references";
+ }
+ my @lines = ();
+ foreach my $el ( @$array ) {
+ my $line = (' ' x $indent) . '-';
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_dump_scalar( $el );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die \"YAML::Tiny does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+sub _dump_hash {
+ my ($self, $hash, $indent, $seen) = @_;
+ if ( $seen->{refaddr($hash)}++ ) {
+ die \"YAML::Tiny does not support circular references";
+ }
+ my @lines = ();
+ foreach my $name ( sort keys %$hash ) {
+ my $el = $hash->{$name};
+ my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":";
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_dump_scalar( $el );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die \"YAML::Tiny does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+
+
+#####################################################################
+# DEPRECATED API methods:
+
+# Error storage (DEPRECATED as of 1.57)
+our $errstr = '';
+
+# Set error
+sub _error {
+ require Carp;
+ $errstr = $_[1];
+ $errstr =~ s/ at \S+ line \d+.*//;
+ Carp::croak( $errstr );
+}
+
+# Retrieve error
+my $errstr_warned;
+sub errstr {
+ require Carp;
+ Carp::carp( "YAML::Tiny->errstr and \$YAML::Tiny::errstr is deprecated" )
+ unless $errstr_warned++;
+ $errstr;
+}
+
+
+
+
+#####################################################################
+# Helper functions. Possibly not needed.
+
+
+# Use to detect nv or iv
+use B;
+
+# XXX-INGY Is flock YAML::Tiny's responsibility?
+# Some platforms can't flock :-(
+# XXX-XDG I think it is. When reading and writing files, we ought
+# to be locking whenever possible. People (foolishly) use YAML
+# files for things like session storage, which has race issues.
+my $HAS_FLOCK;
+sub _can_flock {
+ if ( defined $HAS_FLOCK ) {
+ return $HAS_FLOCK;
+ }
+ else {
+ require Config;
+ my $c = \%Config::Config;
+ $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
+ require Fcntl if $HAS_FLOCK;
+ return $HAS_FLOCK;
+ }
+}
+
+
+# XXX-INGY Is this core in 5.8.1? Can we remove this?
+# XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
+#####################################################################
+# Use Scalar::Util if possible, otherwise emulate it
+
+use Scalar::Util ();
+BEGIN {
+ local $@;
+ if ( eval { Scalar::Util->VERSION(1.18); } ) {
+ *refaddr = *Scalar::Util::refaddr;
+ }
+ else {
+ eval <<'END_PERL';
+# Scalar::Util failed to load or too old
+sub refaddr {
+ my $pkg = ref($_[0]) or return undef;
+ if ( !! UNIVERSAL::can($_[0], 'can') ) {
+ bless $_[0], 'Scalar::Util::Fake';
+ } else {
+ $pkg = undef;
+ }
+ "$_[0]" =~ /0x(\w+)/;
+ my $i = do { no warnings 'portable'; hex $1 };
+ bless $_[0], $pkg if defined $pkg;
+ $i;
+}
+END_PERL
+ }
+}
+
+delete $YAML::Tiny::{refaddr};
+
+1;
+
+# XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
+# but leaving grey area stuff up here.
+#
+# I would like to change Read/Write to Load/Dump below without
+# changing the actual API names.
+#
+# It might be better to put Load/Dump API in the SYNOPSIS instead of the
+# dubious OO API.
+#
+# null and bool explanations may be outdated.
+
+__END__
+
+#line 1490
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index 38d85c6..dc6719e 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -70,9 +70,7 @@ Only run this the first time you install this module.
Add this line:
- Set(@Plugins, qw(RT::Extension::TimeTracking));
-
-or add C<RT::Extension::TimeTracking> to your existing C<@Plugins> line.
+ Plugin('RT::Extension::TimeTracking');
=item Clear your mason cache
@@ -154,19 +152,17 @@ sub WeekStartDate {
=head1 AUTHOR
-sunnavy <sunnavy at bestpractical.com>
+Best Practical Solutions, LLC E<lt>modules at bestpractical.comE<gt>
=head1 BUGS
-All bugs should be reported via email to
-L<bug-RT-Extension-TimeTracking at rt.cpan.org|mailto:bug-RT-Extension-TimeTracking at rt.cpan.org>
-or via the web at
-L<rt.cpan.org|http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-TimeTracking>.
-
+Since this module is not on CPAN, bugs should be reported via
+E<lt>modules at bestpractical.comE<gt>, or via standard BPS support
+contract channels.
-=head1 LICENSE AND COPYRIGHT
+=head1 COPYRIGHT
-Copyright (c) 2013, Best Practical Solutions, LLC.
+This extension is Copyright (C) 2013-2015 Best Practical Solutions, LLC.
This is free software, licensed under:
commit 1c8953969f0614d48f090e991488ba5c900fbb3d
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Wed Apr 15 16:01:35 2015 -0400
Version bump to 0.05
diff --git a/META.yml b/META.yml
index f9683c6..2e8c017 100644
--- a/META.yml
+++ b/META.yml
@@ -25,6 +25,6 @@ requires:
perl: 5.10.1
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: '0.04'
+version: '0.05'
x_module_install_rtx_version: '0.37'
x_requires_rt: 4.2.0
diff --git a/lib/RT/Extension/TimeTracking.pm b/lib/RT/Extension/TimeTracking.pm
index dc6719e..9691112 100644
--- a/lib/RT/Extension/TimeTracking.pm
+++ b/lib/RT/Extension/TimeTracking.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::TimeTracking;
-our $VERSION = '0.04';
+our $VERSION = '0.05';
RT->AddStyleSheets("time_tracking.css");
RT->AddJavaScript("time_tracking.js");
commit 5318321623311716acc8d2cc4e5fcd98df759cbb
Author: Shawn M Moore <shawn at bestpractical.com>
Date: Thu Jul 16 12:55:20 2015 -0400
Autocomplete only privileged users for My Week
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 2a254c6..2acf744 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -27,7 +27,7 @@ input#Date {
<tr><td class="label">
<input type="hidden" name="User" value="<% $User || '' %>" />
<&|/l&>Go to user</&>:</td>
-<td class="value"><input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" id="autocomplete-User" /></td>
+<td class="value"><input type="text" name="UserString" value="" data-autocomplete="Users" data-autocomplete-return="Name" data-autocomplete-privileged=1 id="autocomplete-User" /></td>
</tr>
</div>
% }
commit 193a998f6b62a8f6d4a3799a33e31db485c5416f
Author: Dustin Graves <dustin at bestpractical.com>
Date: Mon Aug 10 20:02:18 2015 +0000
Add prev/next week links
Fixes: I#31120
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index 2acf744..ba06e6a 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -6,7 +6,20 @@
<script type="text/javascript">
jQuery( function() {
- jQuery("div.time_tracking input[name=Date]").datepicker( 'option', 'firstDay', <% ($week_start->Localtime('user'))[6] %> );
+ var jDatePicker = jQuery("div.time_tracking input[name=Date]")
+ jDatePicker.datepicker( 'option', 'firstDay', <% ($week_start->Localtime('user'))[6] %> );
+
+ jQuery("#previous-week").click(function(e) {
+ e.preventDefault();
+ jDatePicker.val("<% $previous_week->Date(Format=>'ISO', Timezone => 'user') %>");
+ jDatePicker.change();
+ });
+
+ jQuery("#next-week").click(function(e) {
+ e.preventDefault();
+ jDatePicker.val("<% $week_end->Date(Format=>'ISO', Timezone => 'user') %>");
+ jDatePicker.change();
+ });
});
</script>
@@ -14,6 +27,12 @@ jQuery( function() {
input#Date {
width: 177px;
}
+.week-links a {
+ text-decoration: underline;
+}
+.week-links td:last-child{
+ text-align: right;
+}
</style>
<div class="time_tracking">
@@ -34,6 +53,10 @@ input#Date {
<tr><td class="label">
<&|/l&>Week of (pick any day in week)</&>:</td>
<td class="value"><& /Elements/SelectDate, ShowTime => 0, Name => 'Date', Default => $date->Date(Format=>'ISO', Timezone => 'user') &></td></tr>
+<tr class="week-links">
+ <td><a href='#' id='previous-week'><< Previous Week</a></td>
+ <td><a href='#' id='next-week'>Next Week >></a></td>
+</tr>
</table>
</form>
@@ -334,6 +357,10 @@ while ( my $txn = $activity_txns->Next ) {
}
}
+my $previous_week = RT::Date->new($user);
+$previous_week->Set( Value => $week_start->Unix );
+$previous_week->AddDays( -7 );
+
</%INIT>
<%ARGS>
commit 2095eb1e52598dcf145a8b4ed6c6b4b4324ac19f
Merge: 5318321 193a998
Author: Shawn M Moore <shawn at bestpractical.com>
Date: Fri Aug 14 15:48:11 2015 -0400
Merge branch 'prev-next-week-links'
commit c627c922adc9ba18a9d86911100d1e588834d3a3
Author: Shawn M Moore <shawn at bestpractical.com>
Date: Mon Dec 7 15:41:37 2015 -0500
Display queue name in My Week
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index ba06e6a..ee64517 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -74,6 +74,7 @@ input#Date {
<tr class="collection-as-table">
<th class="collection-as-table"><&|/l&>id</&></th>
<th class="collection-as-table"><&|/l&>Subject</&></th>
+<th class="collection-as-table"><&|/l&>Queue</&></th>
<th class="collection-as-table"><&|/l&>Status</&></th>
<th class="collection-as-table"><&|/l&>Owner</&></th>
% if ( $display_cf ){
@@ -93,6 +94,7 @@ input#Date {
<td class="collection-as-table">
<a href="<% RT->Config->Get('WebPath') %>/Ticket/Display.html?id=<% $ticket->id %>"><% $ticket->Subject %></a>
</td>
+<td class="collection-as-table"><% $ticket->QueueObj->Name %></td>
<td class="collection-as-table"><% $ticket->Status %></td>
<td class="collection-as-table"><% $ticket->OwnerObj->Name %></td>
% if ( $display_cf ){
commit 010050a4785590780083b84319fbee655c741a75
Author: Shawn M Moore <shawn at bestpractical.com>
Date: Mon Dec 7 15:50:53 2015 -0500
Avoid wrapping the time text box with the unit dropdown
diff --git a/html/Tools/MyWeek.html b/html/Tools/MyWeek.html
index ee64517..bf1d24e 100644
--- a/html/Tools/MyWeek.html
+++ b/html/Tools/MyWeek.html
@@ -101,7 +101,7 @@ input#Date {
<td class="collection-as-table"><% $ticket->FirstCustomFieldValue($display_cf) %></td>
% }
<td class="collection-as-table"><& /Ticket/Elements/ShowTime, minutes => $entry->{time_worked} &></td>
-<td class="collection-as-table">
+<td class="collection-as-table update-time">
<& /Elements/EditTimeValue,
Name => 'Ticket-' . $ticket->id . "-UpdateTimeWorked",
Default => '',
diff --git a/static/css/time_tracking.css b/static/css/time_tracking.css
index e710900..7e70767 100644
--- a/static/css/time_tracking.css
+++ b/static/css/time_tracking.css
@@ -8,6 +8,10 @@ div.day_entry {
position: relative;
}
+div.day_entry .update-time {
+ white-space: nowrap;
+}
+
div.submit_day_time_button {
position: absolute;
bottom: 0;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list