Input.pm

Revision 53, 33.6 kB (checked in by bkuhn, 9 months ago)
Added SFLC's internally developed tim bot released under AGPLv3

Line
1	# Copyright (C) 2005, 2006 Software Freedom Law Center, Inc.
2	# Author: Bradley M. Kuhn <bkuhn@softwarefreedom.org>
3	#
4	# This software gives you freedom; it is licensed to you under version
5	# 3 of the GNU Affero General Public License.
6	#
7	# This software is distributed WITHOUT ANY WARRANTY, without even the
8	# implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
9	# PURPOSE. See the GNU Affero General Public License for further
10	# details.
11	#
12	# You should have received a copy of the GNU Affero General Public
13	# License, version 3 along with this software. If not, see
14	# <http://www.gnu.org/licenses/>.
15	# Input.pm -- Perl --
16	# Input module for
17
18	package SFLC::TimeTracker::Input;
19
20	use strict;
21	use warnings;
22
23	require Exporter;
24
25	#use AutoLoader qw(AUTOLOAD);
26
27	our @ISA = qw(Exporter);
28
29	our @EXPORT_OK = ( );
30
31	our @EXPORT = qw( );
32
33	our $VERSION = '0.01';
34
35	my $SHORTEN_LINE_FOR_REOUTPUT = 15;
36
37	use Tree::Simple;
38
39	use Date::Manip;
40	use Data::Dumper;
41	use Carp;
42	use String::Approx 'amatch';
43
44
45	use SFLC::TimeTracker::Entry;
46	use SFLC::TimeTracker::Category;
47
48	use SFLC::TimeTracker::Input::CategoryParser::ResolutionNode;
49	use SFLC::TimeTracker::Input::CategoryParser;
50
51	use SFLC::TimeTracker::Question::Category;
52
53	use SFLC::TimeTracker::Output;
54	use SFLC::TimeTracker::Output::Dummy;
55	use SFLC::TimeTracker::Output::Statement;
56	use SFLC::TimeTracker::Output::Entry;
57
58	###############################################################################
59	my $PARSE_WORD_LIMIT = 5;
60	my $IN_THE_BEGINNING_THERE_WAS_LIGHT = ParseDate("1975-11-02");
61
62	my %ERROR_MESSAGES = (
63	'TIME INVALID' =>
64	'Couldn\'t find a valid time data in "%s"',
65	'INTERNAL ERROR' =>
66	'REPORT THIS: your line "%s" yielded error of %s.',
67	'NOTHING STARTED' =>
68	'No record of a started entry; nothing was stopped when you said: "%s"',
69	'DUMMY' =>
70	'REPORT THIS: your line "%s" was considered %s!'
71	);
72
73	###############################################################################
74
75	=head1 NAMEuse String::Approx 'amatch';
76
77
78	SFLC::TimeTrack::Input -
79
80	=head1 SYNOPSIS
81
82	use SFLC::TimeTrack::Input;
83
84	=head1 DESCRIPTION
85
86
87	=head2 EXPORT
88
89	None.
90
91	=head1 SEE ALSO
92
93	SFLC::TimeTrack::DB
94
95
96	=head1 EXTERNAL FUNCTIONS
97
98	=over
99
100	=cut
101
102	###############################################################################
103
104	=item new
105
106	usage: new($database)
107
108	=back
109
110	=cut
111	our $DATABASE;
112
113	sub new {
114	my($class) = @_;
115
116	my $self = bless {}, $class;
117
118	return $self;
119	}
120	###############################################################################
121	sub Initialize {
122	$DATABASE = shift;
123	}
124	sub getDatabase {
125	return $DATABASE;
126	}
127
128	###############################################################################
129	sub _isTimeLine ($$$) {
130	my($entryDate, $line, $needFullParsing) = @_;
131
132	my($oP, $cP) = ('(', ')');
133	$oP = '(?:' unless $needFullParsing;
134
135	my $commandExp = $oP . 'pop\|spent\|start\|push\|add\|adjust\|worked(?:\s*on)?' .
136	'\|begin\|started\|ende?d?\|last\|stopp?e?d?(?:\s*on)?' . $cP;
137
138	my $stopExp = $oP . 'ende?d?\|stopp?e?d?(?:\s*on)?' . $cP;
139	my $startExp = $oP . 'begin\|starte?d?(?:\son\|\sat)?' . $cP;
140
141	# If we allowed negative time ...
142	# my $subDigitsExp = '\-?\d+[\d\.]*\|\.\d+';
143	my $subDigitsExp = '\d+[\d\.]*\|\.\d+';
144	my $timeDigitsExp = $oP . $subDigitsExp . $cP;
145	my $timeExp = '(?:\[\|for\|at)?' . $oP . '(?:(?:' . $subDigitsExp . ')\s*' .
146	'(?:mi?nu?t?e?s?\s\|ho?u?rs?\|seco?n?d?s?\|da?ys?)\s[\.,]?\s*)+(?:ago\|later)?'
147	. $cP . '\]?';
148	my $subClockExp = '\d{1,2}\s(?::\s\d{2,2}\s*)?(?:[ap]m?)?';
149	my $clockExp = $oP . $subClockExp .$cP;
150	my $clockEntryExp = '(?:at\|on\|during)?\s*' . $clockExp;
151	my $clockRangeExp = '(?:from)?' . $clockExp .
152	'\s(?:\-+\|to\|until\|through)\s' . $clockExp;
153	my $catExp = '(?:on\s+\|for\s+)?' . $oP . '[^\d\s][^\d]+' . $cP;
154
155	my $subDayExp = '(?:(?:last\s+)?\S+day\|\d{1,2}\/\d{1,2}(?:\/\d{2,4})?)';
156	my $dayExp = $oP . $subDayExp . '\s*(?:\s+at\s+)?' . $subClockExp . $cP;
157
158	my($operation, $time, $startTime, $endTime);
159
160	print "parsing $line\n RE: $stopExp $clockEntryExp\n";
161	if ($line =~ /^\s$stopExp\s+$dayExp\s$/ix or
162	$line =~ /^\s$stopExp\s+$clockEntryExp\s$/ix) {
163	print "DOING DAY EXP $2\n";
164	if ($needFullParsing) {
165	$operation = 'stop';
166	$time = $2;
167	$time =~ s/\s+at\s+/ /i;
168	# We should assume they ment the last one that passed; no stops
169	# should occur into the future
170	$time = "last $time" if $time =~ /^\s*(mon\|tue\|wed\|thu\|fri\|sat\|sun)/i;
171	$line = "";
172	}
173	} elsif ($line =~ /^\s$startExp\s+$dayExp\s+$catExp\s(.*)$/ix) {
174	$operation = 'start';
175	$time = $2;
176	$line = "$3 $4";
177	} elsif ($line =~ /^\s$startExp\s+$clockEntryExp\s+$catExp\s(.*)$/ix) {
178	$operation = 'start';
179	$time = $2;
180	$line = "$3 $4";
181	} elsif ($line =~ /^\s$commandExp\s$timeExp(.*)$/ix) {
182	if ($needFullParsing) {
183	$operation = "\L$1\E";
184	$time = "\L$2\E";
185	$line = $3;
186	}
187	} elsif ($line =~ /^\s$clockRangeExp\s+$catExp\s(.*)$/ix) {
188	if ($needFullParsing) {
189	$operation = "add";
190	$line = "$3 $4";
191
192	my(%times);
193	($times{start}, $times{end}) = ($1, $2);
194
195	foreach my $key (qw/start end/) {
196	if (defined $entryDate and $entryDate !~ /^\s*$/) {
197	$times{$key} = "$entryDate $times{$key}";
198	}
199	my(@tokens) = split(/\s+/, $times{$key});
200	$times{$key} = ParseDate(\@tokens);
201	my $str = join(" ", @tokens);
202	$line = "$str $line" unless ($str =~ /^\s*$/)
203	}
204	$time = DateCalc($times{start}, $times{end});
205	if (defined $time) {
206	$startTime = $times{start};
207	$endTime = $times{end};
208	}
209	}
210	} elsif ($line =~ /^\s$timeExp\s+$commandExp\s+(.)$/ix) {
211	if ($needFullParsing) {
212	$time = "\L$1\E";
213	$operation = "\L$2\E";
214	$line = $3;
215	}
216	} elsif ($line =~ /^\s$commandExp\s+$catExp\s$timeExp(.*)$/ix) {
217	if ($needFullParsing) {
218	$operation = "\L$1\E";
219	$time = "\L$3\E";
220	$line = "$2 $4";
221	}
222	} elsif ($line =~ /^\s$timeExp\s(.*)$/i) {
223	if ($needFullParsing) {
224	$operation = "add";
225	$time = "\L$1\E";
226	$line = $2;
227	}
228	} elsif ($line =~ /^\s$timeDigitsExp(?![,\-;\/])\s(.*)$/i) {
229	if ($needFullParsing) {
230	$operation = "add";
231	$time = "$1 ASSUMED_UNIT_UNQUALIFIED";
232	$line = $2;
233	}
234	} elsif ($line =~ /^\s$commandExp\s$clockEntryExp(.*)$/ix) {
235	if ($needFullParsing) {
236	$operation = "\L$1\E";
237	$line = $3;
238	$startTime = $2;
239	unless (defined $startTime and $startTime !~ /^\s*$/) {
240	$line = "$startTime $line" if defined $startTime;
241	$startTime = undef;
242	}
243
244	}
245	} elsif ($line =~ /^\s$clockEntryExp\s$commandExp(.*)$/ix) {
246	if ($needFullParsing) {
247	$operation = "\L$2\E";
248	$line = $3;
249	$startTime = $1;
250	unless (defined $startTime and $startTime !~ /^\s*$/) {
251	$line = "$startTime $line" if defined $startTime;
252	$startTime = undef;
253	}
254
255	}
256	} elsif ($line =~ /^\s$commandExp\s$timeExp(.*)$/ix) {
257	if ($needFullParsing) {
258	$operation = "\L$1\E";
259	$time = "\L$2\E";
260	$line = $3;
261	}
262	} elsif ($line =~ /^\s$commandExp\s$timeDigitsExp(.*)$/ix) {
263	if ($needFullParsing) {
264	$operation = "\L$1\E";
265	$time = ($operation eq "pop") ? $2 : "$2 ASSUMED_UNIT_UNQUALIFIED";
266	$line = $3;
267	}
268	} elsif ($line =~ /^\s$commandExp(.)$/ix) {
269	if ($needFullParsing) {
270	$operation = "\L$1\E";
271	$line = $2;
272	$time = undef;
273	}
274	} elsif ($line =~ /^\s$catExp\s[\s,:\.]$commandExp\s$timeExp\s(.)$/ix) {
275	if ($needFullParsing) {
276	$operation = "\L$2\E";
277	$time = "\L$3\E";
278	$line = "$1 $4";
279	}
280	} elsif ($line =~ /^\s$catExp\s[\s,:\.]+\s$timeExp\s(.*)$/ix) {
281	if ($needFullParsing) {
282	$operation = "add";
283	$time = "\L$2\E";
284	$line = "$1 $3";
285	}
286	} else {
287	return undef;
288	}
289	if (not $needFullParsing) {
290	return {};
291	} else {
292	if ($operation =~ /^\s*worked/) {
293	$operation = "add";
294	$line =~ s/^\s(?:on\s+)?(.)\s+for\s+(.*)$/$2 $1/i;
295	} elsif ($operation eq "begin") {
296	$operation = "start";
297	} elsif ($operation =~ /^start/) {
298	$operation = "start";
299	} elsif ($operation =~ /^end/) {
300	$operation = "stop";
301	} elsif ($operation =~ /^stop/) {
302	$operation = "stop";
303	} elsif ($operation eq "last") {
304	$operation = "adjust";
305	} elsif ($operation eq "spent") {
306	$operation = "add";
307	}
308	while ($line =~ s/(?:^\|\s+)(?:total\|today\|for\|from\|last)(?:\s+\|$)/ /g) { } ;
309	if ($operation eq "stop") {
310	$endTime = $startTime;
311	$startTime = undef;
312	}
313	return ($needFullParsing ?
314	{ operation => $operation, time => $time, rest => $line,
315	startTime => $startTime, endTime => $endTime }
316	: {});
317	}
318	}
319
320	###############################################################################
321
322	sub _FindTimesInLine ($$) {
323	my($dateForEntry, $inputLine) = @_;
324
325	# remove trailing ; or "and" before we split on that
326
327	$inputLine =~ s/(?:;\|and)\s*$//i;
328
329	my(@firstLineSet) = split(/(?:\s+[,\.;]?\sand\s[,\.;]?\s+\|\s*;\s+)/i,
330	$inputLine);
331
332	# Search through the split lines and try to find comma-seperated entries
333	# that seem to be seperate.
334	my @lines = ();
335	my($lastMatchIndex, $matchedCount) = (-1, 0);
336	foreach my $line (@firstLineSet) {
337	my(@subLines) = split(/\s,\s/i, $line);
338	foreach my $subLine (@subLines) {
339	# This is somewhat ineffecient here, because I process the lines twice; once to figure
340	# out if how the comma seperation should work and second to do the actual parsing
341	# ... but it avoids code duplication on the "hour detecting" stuff in _isTimeLine
342	if (defined _isTimeLine($dateForEntry, $subLine, 0)) {
343	push(@lines, $subLine);
344	$matchedCount++; $lastMatchIndex = $#lines;
345	} else {
346	push(@lines, undef) if @lines == 0;
347	(defined $lines[$#lines]) ? ($lines[$#lines] .= ", $subLine") :
348	($lines[$#lines] = $subLine);
349	}
350	}
351	}
352	# Special case if we found only one subline that has a match --- put it
353	# up front and everything else after it
354	if ($matchedCount == 1) {
355	my $str = $lines[$lastMatchIndex] . join(",", @lines[0.. ($lastMatchIndex -1)]);
356	$lastMatchIndex++;
357	$str .= join(",", @lines[$lastMatchIndex .. $#lines]) if ($lastMatchIndex <= $#lines);
358	$lines[0] = $str; $#lines = 0;
359	}
360
361
362	my %times;
363	my $rest = "";
364	foreach my $line (@lines) {
365	my $firstHash = _isTimeLine($dateForEntry, $line, 1);
366	if (defined $firstHash) {
367	$times{$line} = $firstHash;
368	} else {
369	($rest =~ /^\s*$/) ? ($rest = $line) : ($rest .= $line);
370	}
371	# Ok, from this point on, we have a valid $operation
372	}
373	return { timeInfo => \%times, rest => $rest }
374	}
375	###############################################################################
376	sub _operationDUMMY ($$$$$) {
377	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
378	$dateForEntry = "" unless defined $dateForEntry;
379	die "NO MORE DUMMYS\n";
380	return (["DUMMY", undef]);
381	}
382	###############################################################################
383	sub _operationStart ($$$$$$) {
384	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
385
386	my $status = "";
387	my %entries;
388	$entries{completed} = [];
389	do {
390	my $thisEntries;
391	my(@l) =
392	$self->_operationStop($timeStamp, $dateForEntry, $buildData, $timeInfo);
393	($status, $thisEntries) = @{$l[0]};
394	push(@{$entries{completed}}, @{$thisEntries->{completed}})
395	if ($status =~ /^STOPPED/ and @{$thisEntries->{completed}} >= 1);
396	push(@{$entries{abandoned}}, @{$thisEntries->{abandoned}})
397	if ($status =~ /^STOPPED/ and @{$thisEntries->{abandoned}} >= 1);
398	} until ($status !~ /^STOPPED/);
399
400	my $startTime;
401	foreach my $key (qw/startTime time/) {
402	$startTime = ParseDate($timeInfo->{$key})
403	if (defined $timeInfo->{$key} and $timeInfo->{$key} !~ /^\s*$/);
404	last if defined $startTime;
405	}
406	$startTime = $timeStamp if not defined $startTime;
407	unless (defined $startTime and $startTime !~ /^\s*$/) {
408	$status = "STARTED WITH CURRENT TIME DUE TO INVALID TIME";
409	$startTime = $timeStamp;
410	}
411
412	$entries{new} = [];
413	$entries{new}[0] = SFLC::TimeTracker::Entry::Create(
414	userHandle => $buildData->{userHandle},
415	dateOccurred => $timeStamp,
416	startTime => $startTime);
417
418	return(["STARTED", \%entries]);
419	}
420	###############################################################################
421	sub _operationStop ($$$$$) {
422	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
423
424	$self->getDatabase()->stackClear($buildData->{userHandle});
425
426	my $pending = $buildData->{pendingUserEntries};
427	my(@startedList);
428	foreach my $pp (keys %{$pending}) {
429	push(@startedList, $pending->{$pp})
430	if ($pending->{$pp}->needs("endTime") and
431	defined $pending->{$pp}->{startTime});
432	}
433
434	my $finishedEntry;
435	if (@startedList <= 0) {
436	return(["NOTHING STARTED", undef]);
437	}
438
439	my $status = "STOPPED WITH REQUESTED TIME";
440	my $stopTime;
441	my $triedThem = 0;
442	foreach my $key (qw/endTime time/) {
443	if (defined $timeInfo->{$key} and $timeInfo->{$key} !~ /^\s*$/) {
444	$stopTime = ParseDate($timeInfo->{$key});
445	print "Got stoptiem of $stopTime\n";
446	$triedThem = 1;
447	}
448	last if defined $stopTime;
449	}
450	unless (defined $stopTime and $stopTime !~ /^\s*$/) {
451	$stopTime = $timeStamp;
452	$status = $triedThem ? "STOPPED WITH CURRENT TIME DUE TO INVALID TIME"
453	: "STOPPED";
454	}
455	my %entries; $entries{completed} = []; $entries{abandoned} = [];
456	foreach my $finishedEntry (@startedList) {
457	$finishedEntry->set("endTime", $stopTime);
458	if ($stopTime gt $finishedEntry->get('startTime')) {
459	push(@{$entries{completed}}, $finishedEntry);
460	} else {
461	push(@{$entries{abandoned}}, $finishedEntry);
462	}
463	}
464	return ([ $status, \%entries]);
465	}
466	###############################################################################
467	sub _operationPush ($$$$$) {
468	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
469
470	#FIXME!!!
471	return $self->_operationStop($timeStamp,
472	$dateForEntry, $buildData, $timeInfo);
473
474	my @answers;
475
476	my($status, $category) = ("", undef);
477
478	my %entries = (); $entries{completed} = [];
479	my $thisEntries;
480	my(@l) =
481	$self->_operationStart($timeStamp, $dateForEntry, $buildData, $timeInfo);
482
483	my(@dead);
484	my $ii = -1;
485	my $started;
486	foreach my $ar (@l) {
487	$ii++;
488	push(@dead, @{$ar->[1]->{completed}});
489	$started = $ii if $ar->[0] eq "STARTED";
490	}
491
492	if (@dead > 0) {
493	@dead = sort { $a->{startTime} cmp $b->{startTime} } @dead;
494	$self->getDatabase()->stackPush($dead[0]);
495	} else {
496	$l[$started][0] = "PUSHED" if defined $started;
497	}
498	return @l;
499	}
500	###############################################################################
501	sub _operationPrintStack ($$$$$) {
502	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
503
504	my(@stack) = $self->getDatabase()->stackList($buildData->{userHandle});
505
506	return ([ "STACK LIST", { completed => \@stack}]);
507	}
508	###############################################################################
509	sub _operationPop ($$$$$) {
510	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
511
512	#FIXME!!!
513	return $self->_operationStart($timeStamp,
514	$dateForEntry, $buildData, $timeInfo);
515	my @answers;
516	my $poppedItem = $self->getDatabase()->stackPop($buildData->{userHandle});
517
518	my($status, $category) = ("", undef);
519	if (not defined $poppedItem) {
520	push(@answers, [ "STACK EMPTY", undef ]);
521	} elsif ($poppedItem->needs('category')) {
522	push(@answers, [ "POPPED WITHOUT CATEGORY", { completed => [$poppedItem] }]);
523	} else {
524	push(@answers, [ "POPPED WITH CATEGORY", { completed => [$poppedItem] }]);
525	# $timeInfo->{categoryID} = $poppedItem->get('category')->get('id');
526	# FIXME: CATEGORY
527	}
528
529	my %entries = (); $entries{completed} = [];
530	my $thisEntries;
531	my(@l) =
532	$self->_operationStart($timeStamp, $dateForEntry, $buildData, $timeInfo);
533
534	foreach my $ar (@l) {
535	$ar->[0] = "POPPED" if $ar->[1] eq "STOPPED";
536	push(@answers, $ar);
537	}
538	return @answers;
539	}
540	###############################################################################
541	sub _operationAdd ($$$$$) {
542	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
543
544	my($amountTime, $startTime, $endTime);
545	$amountTime = ParseDateDelta($timeInfo->{time});
546	$startTime = ParseDate($timeInfo->{startTime})
547	if defined $timeInfo->{startTime};
548	$endTime = (defined $timeInfo->{endTime}) ?
549	ParseDate($timeInfo->{endTime}) : $timeStamp;
550	$endTime = $timeStamp unless defined $endTime and $endTime !~ /^\s*$/;
551
552	print "Got $amountTime in Add\n";
553	return (["TIME INVALID", undef])
554	unless (defined $amountTime and $amountTime !~ /^\s*$/);
555
556	my $entry = SFLC::TimeTracker::Entry::Create(
557	userHandle => $buildData->{userHandle},
558	dateOccurred => $dateForEntry,
559	amountTime => $amountTime,
560	endTime => $endTime,
561	startTime => $startTime);
562
563	my $status;
564	# print "KEYS:", join(", ", keys %{$entry->{$key}{needToComplete}});
565
566	# FIXME: CATEGORY_HARDCODE, I think...
567	# $status = $entry->isComplete() ? "INCOMPLETE ENTRY" : "ADDED";
568	$status = "ADDED";
569	return([$status, { new => [$entry] }] );
570	}
571	###############################################################################
572	sub _operationAdjust ($$$$$) {
573	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
574	my $pending = $buildData->{pendingUserEntries};
575	my(@startedList);
576	foreach my $pp (keys %{$pending}) {
577	push(@startedList, $pending->{$pp})
578	if ($pending->{$pp}->needs("endTime") and defined $pending->{$pp}->{startTime});
579	}
580
581	my $startedEntry;
582	if (@startedList == 0) {
583	my(@l) =
584	$self->_operationAdd($timeStamp, $dateForEntry, $buildData, $timeInfo);
585	my($status, $entries) = @{$l[0]};
586	$status = "ADDED, NO ENTRY TO ADJUST" if ($status eq "ADDED");
587	return ([$status, $entries ]);
588	} elsif (@startedList > 1) {
589	warn "Multiple entries have been started!";
590	print @startedList;
591	return (["INTERNAL ERROR - MULTIPLE STARTS", undef]);
592	} else {
593	$startedEntry = $startedList[0];
594	}
595	my $adjustTime = ParseDateDelta($timeInfo->{time});
596
597	return (["TIME INVALID", undef])
598	unless (defined $adjustTime and $adjustTime !~ /^\s*$/);
599
600	my %entries;
601	$entries{abandoned} = [];
602	my $remainingAdjustment = $adjustTime;
603	my $interruptedEntry;
604
605	my $newStartTime = DateCalc($startedEntry->{startTime}, $remainingAdjustment);
606
607	if (not defined $newStartTime or $newStartTime =~ /^\s*$/) {
608	carp "DateCalc of $timeStamp to $adjustTime failed and yieleded $newStartTime";
609	return (["INTERNAL ERROR - TIME PARSE", undef]);
610	}
611	if ($newStartTime ge $timeStamp) {
612	$startedEntry->remove();
613	push(@{$entries{abandoned}}, $startedEntry);
614	} else {
615	$startedEntry->set('startTime', $newStartTime);
616	$interruptedEntry = $startedEntry;
617	}
618
619	$entries{new} = [];
620	$entries{new}[0] = SFLC::TimeTracker::Entry::Create(
621	userHandle => $buildData->{userHandle},
622	dateOccurred => $dateForEntry,
623	amountTime => $adjustTime,
624	endTime => $timeStamp);
625
626	$entries{modified}[0] = $interruptedEntry if (defined $interruptedEntry);
627
628	# $pending->{$pp}->set('endTime', $newEnd);
629	return(["ADJUSTED", \%entries]);
630
631	}
632	###############################################################################
633	sub _processOperation ($$$$$) {
634	my ($self, $timeStamp, $dateForEntry, $buildData, $timeInfo) = @_;
635
636	# First, remove leading and trailing punctuation from the remaining string
637
638	$timeInfo->{rest} =~ s/^\s*[:;\-\>\<\[\]]\///;
639	$timeInfo->{rest} =~ s/\s*[:;\-\>\<\[\]]\/$//;
640
641	# Now, let's see if we have a new date string
642	# unless (defined $dateForEntry and $dateForEntry !~ /^\s*$/) {
643	# my $delta;
644	# ($delta, $timeInfo->{rest}) =
645	# _RemoveDateFromStringStart($timeInfo->{rest}, \&ParseDateDelta);
646	# $dateForEntry = DateCalc($timeStamp, $delta)
647	# if (defined $delta and $delta !~ /^\s*$/);
648
649	# Ok, it wasn't a delta, look for a date straight-up
650	unless (defined $dateForEntry and $dateForEntry !~ /^\s*$/) {
651	($dateForEntry, $timeInfo->{rest}) =
652	_RemoveDateFromStringStart($timeInfo->{rest}, \&ParseDate);
653	}
654	# If we couldn't find a date string from the front, we just assume it is now.
655	$dateForEntry = $timeStamp
656	unless defined $dateForEntry and $dateForEntry !~ /^\s*$/;
657	# Re-remove punctuation
658	$timeInfo->{rest} =~ s/^\s*[:;\-\>\<\[\]]\///;
659	$timeInfo->{rest} =~ s/\s*[:;\-\>\<\[\]]\/$//;
660	# }
661
662	if ($timeInfo->{operation} eq "start") {
663	$self->getDatabase()->stackClear($buildData->{userHandle});
664	return $self->_operationStart($timeStamp, $dateForEntry, $buildData,
665	$timeInfo);
666	} elsif ($timeInfo->{operation} eq "stop") {
667	$self->getDatabase()->stackClear($buildData->{userHandle});
668	return $self->_operationStop($timeStamp, $dateForEntry, $buildData,
669	$timeInfo);
670	} elsif ($timeInfo->{operation} eq "add") {
671	return $self->_operationAdd($timeStamp, $dateForEntry, $buildData, $timeInfo);
672	} elsif ($timeInfo->{operation} eq "adjust") {
673	return $self->_operationAdjust($timeStamp, $dateForEntry, $buildData,
674	$timeInfo);
675	} elsif ($timeInfo->{operation} eq "push") {
676	return $self->_operationPush($timeStamp, $dateForEntry, $buildData,
677	$timeInfo);
678	} elsif ($timeInfo->{operation} eq "pop") {
679	return $self->_operationPop($timeStamp, $dateForEntry, $buildData, $timeInfo);
680	} else {
681	croak "Unknown operation $timeInfo->{operation} on $timeStamp";
682	}
683	}
684
685	###############################################################################
686	sub _PreprocessInputLine ($) {
687	my($inputLine) = @_;
688	my $dateForEntry;
689	# Preprocessing of line before finding seperate sections
690
691	chomp $inputLine;
692
693	# Remove addressing
694	$inputLine =~ s/^\stime?\s:?//;
695
696
697	# Take care of "half an hour" and such things
698	$inputLine =~ s/(^\|\s+)quarter(?:\s+of)?(?:\s+an?)?($\|\s+)/${1}0.25$2/gi;
699	$inputLine =~ s/(^\|\s+)half(?:\s+of)?(?:\s+an?)?($\|\s+)/${1}0.5$2/gi;
700	$inputLine =~ s/(^\|\s+)(\d+)\s{1,3}1\/2(?:\s+of)?(?:\s+an?)?($\|\s+)/$1$2.5$3/g;
701	$inputLine =~ s/(^\|\s+)1\/2(?:\s+of)?(?:\s+an?)?($\|\s+)/${1}0.5$2/g;
702	$inputLine =~ s/(^\|\s+)quarter(?:\s+of)?(?:\s+an?)?($\|\s+)/${1}0.25$2/gi;
703
704	$inputLine =~ s/(^\|\s+)one($\|\s+)/${1}1$2/gi;
705	$inputLine =~ s/(^\|\s+)two($\|\s+)/${1}2$2/gi;
706	$inputLine =~ s/(^\|\s+)three($\|\s+)/${1}3$2/gi;
707	$inputLine =~ s/(^\|\s+)four($\|\s+)/${1}4$2/gi;
708	$inputLine =~ s/(^\|\s+)five($\|\s+)/${1}5$2/gi;
709	$inputLine =~ s/(^\|\s+)six($\|\s+)/${1}6$2/gi;
710	$inputLine =~ s/(^\|\s+)seven($\|\s+)/${1}7$2/gi;
711	$inputLine =~ s/(^\|\s+)eight($\|\s+)/${1}8$2/gi;
712	$inputLine =~ s/(^\|\s+)nine($\|\s+)/${1}9$2/gi;
713	$inputLine =~ s/(^\|\s+)ten($\|\s+)/${1}10$2/gi;
714
715	$inputLine =~ s/([^\d]\|^)(^\|\s+)hour($\|\s+)([^\d]\|$)/$1${2}1 hour$3$4/gi;
716
717	# Find dates that have been seperated with dashes rater than slashes
718
719	$inputLine =~ s%(^\|[\s,;]+)(\d{1,2})\-(\d{1,2})-(\d{2,4})
720	($\|[\s,;]+)%$1$2/$3/$4$5%x;
721	$inputLine =~ s%(^\|[\s,;]+)(\d{1,2})\-(\d{1,2})($\|[\s,;]+)%$1$2/$3$4%;
722
723	$inputLine =~ s/last\s+(?:night\|day)/yesterday/g;
724	$inputLine =~ s/yeste?r?da?y/yesterday/g;
725
726	# Handle "Hours (for\|on) DATE: REAL_INFO
727
728	# or $inputLine =~ /^\s([^:;\-]+)[:;\-]\s([^:;\-\s]+)/
729
730	if ($inputLine =~
731	s/^\s(?:hours?)?\s(?:on\|for\|during\|at)\s+([^:;\-]+)\s*[:;\-]/$1/i) {
732	($dateForEntry, $inputLine) = _RemoveDateFromStringStart($inputLine,
733	\&ParseDate);
734	}
735	if ($inputLine =~ /^\s(\S+)\s,/) {
736	my $possibleDate = $1;
737	$dateForEntry = ParseDate($possibleDate);
738	$inputLine =~ s/^\s(\S+)\s,//
739	if (defined $dateForEntry and $dateForEntry !~ /^\s*$/);
740	}
741
742	return ($dateForEntry, $inputLine);
743	}
744	###############################################################################
745	sub _RemoveDateFromStringStart ($$) {
746	my($line, $dateParseFunction) = @_;
747	my($newLine, $foundDate);
748
749	$line =~ s/^\s*([^:;\-]+?)[:;\-]([^0-9])/$1 $2/;
750	my(@words) = split /\s+/, $line;
751	my(@limitForSpeed, @rest);
752	if (@words <= $PARSE_WORD_LIMIT) {
753	@limitForSpeed = @words;
754	@rest = ();
755	} else {
756	@limitForSpeed = @words[0 .. ($PARSE_WORD_LIMIT -1)];
757	@rest = @words[$PARSE_WORD_LIMIT .. $#words];
758	}
759	$foundDate = $dateParseFunction->(\@limitForSpeed);
760	$newLine = join(" ", @limitForSpeed, @rest);
761	return ($foundDate, $newLine);
762	}
763	###############################################################################
764	sub _buildTimeData ($$$$) {
765	my($self, $timeStamp, $userHandle, $originalLine) = @_;
766
767	$self->{currentOriginalLine} = $originalLine;
768
769	my($dateForEntry, $inputLine) = _PreprocessInputLine($originalLine);
770
771	my $data = _FindTimesInLine($dateForEntry, $inputLine);
772
773	use Data::Dumper;
774	print "First FindTimes in line: ", Data::Dumper->Dump([$data]);
775	# If we don't find time data, see if we actually have a string that starts
776	# with a date. If it does, then we use that date as the entry date, and
777	# try to process the rest of the line as the actual operation.
778
779	if (not defined $data->{timeInfo} or keys(%{$data->{timeInfo}}) == 0) {
780	($dateForEntry, $inputLine) = _RemoveDateFromStringStart($data->{rest},
781	\&ParseDate);
782	$data = _FindTimesInLine($dateForEntry, $inputLine);
783	print "Second FindTimes in line: ", Data::Dumper->Dump([$data]);
784	}
785	$data->{dateForEntry} = $dateForEntry;
786	return $data;
787	}
788	###############################################################################
789	sub dryRun {
790	my($self, $timeStamp, $user, $originalLine) = @_;
791
792	my $userHandle = $self->getDatabase()->getUserHandle($user);
793
794	my $data = $self->_buildTimeData($timeStamp, $userHandle, $originalLine);
795
796	$data->{rest} =~ s/^\s*[:;\-\>\<\[\]]\///;
797	$data->{rest} =~ s/\s*[:;\-\>\<\[\]]\/$//;
798
799	unless (defined $data->{dateForEntry} and $data->{dateForEntry} !~ /^\s*$/) {
800	($data->{dateForEntry}, $data->{rest}) =
801	_RemoveDateFromStringStart($data->{rest}, \&ParseDate);
802	}
803	return $data;
804	}
805	###############################################################################
806	sub checkIfLineIsTime ($$$$) {
807	my($self, $timeStamp, $user, $originalLine) = @_;
808
809	my $userHandle = $self->getDatabase()->getUserHandle($user);
810
811	my $data = $self->_buildTimeData($timeStamp, $userHandle, $originalLine);
812
813	return (keys %{$data->{timeInfo}} > 0);
814
815	}
816	###############################################################################
817	# timeStamp is assumed to be truly unique. If it isn't, prefix it with
818	# something before you call this method!
819
820	sub parseLine ($$$$$) {
821	my($self, $timeStamp, $user, $originalLine, $forceParsing) = @_;
822
823	$forceParsing = 0 unless defined $forceParsing;
824
825	# If the user does not exist, bail out
826	my $userHandle = $self->getDatabase()->getUserHandle($user);
827
828	return new Tree::Simple(
829	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
830	object => new SFLC::TimeTracker::Output::Statement(
831	string => "", status => "EMPTY LINE", type => "")))
832	unless defined $originalLine and $originalLine !~ /^\s*$/;
833
834	return ($forceParsing ? ( new Tree::Simple(
835	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
836	object => new SFLC::TimeTracker::Output::Statement(
837	string => "I am sorry, but I just don't know you well " .
838	"enough to store time for you.",
839	status => "UNKNOWN USER", type => ""))))
840	: undef)
841	if (not defined $userHandle);
842
843
844	# check to see if this is a line we've been told to ignore.
845
846	return ($forceParsing ? (new Tree::Simple(
847	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
848	object => new SFLC::TimeTracker::Output::Statement(
849	string => "", status => "IGNORED", type => ""))))
850	: undef)
851	if $self->getDatabase()->checkIgnoreLines($userHandle, $originalLine);
852
853
854	my $data = $self->_buildTimeData($timeStamp, $userHandle, $originalLine);
855
856	# If the user wanted us to, we should now process each time data entry
857	# we were able to find, and build the return objects.
858
859	my($retTree, $leafEdge);
860	$retTree = $leafEdge = new Tree::Simple(
861	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
862	object => new SFLC::TimeTracker::Output::Dummy(
863	string => "", status => "DUMMY", type => ""),
864	edge => 'proceed'));
865
866	foreach my $key (keys %{$data->{timeInfo}}) {
867	my $timeInfo = $data->{timeInfo}{$key};
868	if (not defined $timeInfo->{time}) {
869	$timeInfo->{time} = "";
870	} elsif ($timeInfo->{rest} =~ /^\s*$/
871	and $data->{rest} !~ /^\s*$/) {
872	$timeInfo->{rest} = $data->{rest};
873	$data->{rest} = "";
874	}
875	# FIXME: CONFIG_OPTIONS
876	my $str = ($user =~ /^\s*(?:user2)/) ? "minutes" : "hours";
877	$timeInfo->{time} =~
878	s/(^\|\s+)ASSUMED_UNIT_UNQUALIFIED(\s+\|$)/$1$str$2/g;
879
880	my $prevData = {};
881	$prevData->{pendingUserEntries} =
882	$self->getDatabase()->getPendingEntriesByUserHandle($userHandle);
883	$prevData->{userHandle} = $userHandle;
884	# $prevData->{categoryParser} = "OldCategoryQuestion";
885	# $prevData->{categoryParser} = "BasicLawyer";
886	# $prevData->{categoryParser} = "AdminAssume";
887	$prevData->{categoryParser} =
888	$self->getDatabase()->getUserConfigValue($userHandle, 'categoryParser');
889
890	my(@operationParsed) =
891	$self->_processOperation($timeStamp, $data->{dateForEntry},
892	$prevData, $timeInfo);
893
894	my($resolutionTree, $entryResolver, $note);
895	if ($timeInfo->{operation} !~ /^pop\|stop/) {
896	($resolutionTree, $entryResolver, $note) =
897	$self->_determineCategory($userHandle, $timeInfo->{rest},
898	$prevData->{categoryParser}, $timeStamp);
899	}
900	foreach my $item (@operationParsed) {
901	my($status, $entries) = @{$item};
902	if ($status =~
903	/^(TIME\s+INVALID\|NOTHING\s+STARTED\|INTERNAL\s+ERROR\|DUMMY)/) {
904	my $shortStat = $1;
905	$shortStat =~ s/\s+/ /g;
906	my $shortendLine = (length($originalLine) <= $SHORTEN_LINE_FOR_REOUTPUT)
907	? $originalLine
908	: ( (substr($originalLine, 0, $SHORTEN_LINE_FOR_REOUTPUT)) . " ...");
909
910	my $invalid = new Tree::Simple(
911	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
912	object => new SFLC::TimeTracker::Output::Statement(
913	string =>
914	sprintf($ERROR_MESSAGES{$status},
915	$originalLine, $status),
916	status => $status, type => ""),
917	edge => 'proceed'));
918	$leafEdge->addChild($invalid);
919	} else {
920	foreach my $key (sort keys %{$entries}) {
921	foreach my $entry (@{$entries->{$key}}) {
922
923	my $object = new SFLC::TimeTracker::Output::Entry(
924	entry => $entry,
925	status => $status, type => $key);
926	if ($entry->needs('category')) {
927	confess("Woah! $entry->{id} needs a category, but there is no" .
928	" entryResolver!") unless defined $entryResolver;
929	$entryResolver->addEntry($object);
930	$entry->set('note', $note) if defined $note;
931	} else {
932	$leafEdge->addChild(new Tree::Simple(new
933	SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
934	object => $object, edge => 'proceed')));
935	}
936	}
937	}
938	}
939	}
940	$leafEdge->addChild($resolutionTree) if (defined $resolutionTree);
941	}
942	if ($data->{rest} !~ /^\s*$/) {
943	if ( (not $retTree->isLeaf()) or $forceParsing) {
944	my(@sibs) = $leafEdge->getAllChildren();
945	my $string = (@sibs > 0) ?
946	"(Also, heard you say \"$data->{rest}\", but found no time entry.)" :
947	"Heard you say \"$data->{rest}\", but found no time entry.";
948
949	$leafEdge->addChild(new Tree::Simple(
950	new SFLC::TimeTracker::Input::CategoryParser::ResolutionNode(
951	object => new SFLC::TimeTracker::Output::Statement(
952	string => $string,
953	status => "UNPARSEABLE", type => ""),
954	edge => 'proceed')));
955	}
956	}
957
958	return ( (not $retTree->isLeaf()) or $forceParsing) ? $retTree : undef;
959	}
960	###############################################################################
961	# _determineCategory should return a list of two items. The first should be
962	# the root node of the resolution tree, and the second should be the leaf node
963	# with the edge of "category" to that tree.
964
965	sub _determineCategory ($$$$) {
966	my($self, $userHandle, $categoryLine, $categoryParserName, $timeStamp) = @_;
967
968	my $parser = new SFLC::TimeTracker::Input::CategoryParser($categoryParserName,
969	userHandle => $userHandle);
970	my($a,$b) = $parser->parse("File new entry", $categoryLine, $timeStamp);
971	my $note = $parser->get('note');
972	return($a, $b, $note);
973
974	# $self->getDatabase()->addCategory($categoryCandidate);
975	# $timeInfo->{categoryID} = $categoryCandidate;
976	}
977
978	###############################################################################
979	1;
980	__END__
981
982	#
983	# Local variables:
984	# compile-command: "perl -I ../../../Modules -c Input.pm"
985	# End:

Note: See TracBrowser for help on using the browser.

Software Freedom Law Center

Loblaw

root/trunk/antimatter/tim/Modules/SFLC/TimeTracker/Input.pm

Download in other formats: