Also look in the next-highest directory when detecting VCS; add SVN
[interchange.git] / code / UI_Tag / traffic_report.coretag
1 # Copyright 2002-2007 Interchange Development Group and others
2
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.  See the LICENSE file for details.
7
8 UserTag traffic-report Order   save
9 UserTag traffic-report addAttr
10 UserTag traffic-report Version 1.6
11 UserTag traffic-report Routine <<EOR
12 sub {
13         my ($save, $opt) = @_;
14
15         use Search::Dict;
16
17         my %header = (
18                 date    => errmsg('Date'),
19                 affiliate       => errmsg('Affiliate'),
20                 campaign        => errmsg('Campaign'),
21                 visits  => errmsg('Visits'),
22                 hits    => errmsg('Hits'),
23                 pages   => errmsg('Pages'),
24                 views   => errmsg('Prod. views'),
25                 incart  => errmsg('Items in cart'),
26                 orders  => errmsg('Orders'),
27         );
28
29         my %hmap = qw/
30                 VIEWPAGE pages
31                 VIEWPROD views
32                 ADDITEM  incart
33                 ORDER    orders
34         /;
35
36         if(ref $opt->{header}) {
37                 for(keys %{$opt->{header}}) {
38                         $header{$_} = errmsg($opt->{header}{$_});
39                 }
40         }
41
42         my $cols = $opt->{show} || 'date affiliate visits hits pages views incart orders';
43         my @cols = grep /\w/, split /[\0,\s]+/, $cols;
44         my $numcols = scalar(@cols);
45
46         my @out = <<EOF;
47 <TABLE width="90%" border=0 cellpadding=0 cellspacing=0>
48 <tr class=rborder height=1><td colspan=8></td></tr>
49 <TR class=rmarq>
50 EOF
51         for(@cols) {
52                 push @out, "<TD VALIGN=top>$header{$_}</td>";
53         }
54
55         push @out, <<EOF;
56 </TR>
57 <tr class=rborder height=1><td colspan=8></td></tr>
58 EOF
59
60         my $file = $Vend::Cfg->{TrackFile};
61         unless (-f $file) {
62                 push @out, "<tr><td colspan=$numcols class=error>No traffic statistics found</td></tr></table>";
63                 return;
64         }
65
66         unless(open REPORT, "< $file") {
67                 push @out, "<tr><td colspan=$numcols class=error>Cannot open file $file</td></tr></table>";
68                 return;
69         }
70
71         my $affiliate = $opt->{affiliate} || $CGI::values{affiliate};
72         my $begin_date = $opt->{begin_date} || $CGI::values{ui_begin_date};
73         my $end_date = $opt->{end_date} || $CGI::values{ui_end_date};
74         my $Tag = new Vend::Tags;
75
76         if($begin_date) {
77                 $begin_date = filter_value('date_change', $begin_date);
78                 look(\*REPORT, $begin_date) if $begin_date;
79         }
80
81         $end_date = filter_value('date_change', $end_date)
82                 if $end_date;
83
84         my %names = qw/
85                  01 January
86                  02 February
87                  03 March
88                  04 April
89                  05 May
90                  06 June
91                  07 July
92                  08 August
93                  09 September
94                  10 October
95                  11 November
96                  12 December
97         /;
98
99     my $timeout = $::Variable->{VISIT_TIMEOUT} || (30 * 10);
100
101         my $by_day = $opt->{by_day} || $CGI::values{ui_by_day};
102         my $len;
103         $len = $by_day ? 8 : 6;
104
105         my $done;
106         my $prev;
107         my $break_check = sub {
108                 if(! defined($prev)) {
109                         $prev = $_[0];
110                         return;
111                 }
112                 if ($end_date and $_[0] gt $end_date) {
113                         $done = 1;
114                         return 1;
115                 }
116                 return if $_[0] eq $prev;
117                 $prev = $_[0];
118                 return 1;
119         };
120
121
122   BREAK: {
123     my $hits;
124     my $interval_count = 0;
125     my $interval_total = 0;
126     my $max_interval = 0;
127     my $min_interval = 9999999;
128     my $out = '';
129     my $visits;
130     my $visit_number;
131     my %action_by_aff;
132     my %action_by_day;
133     my %action_by_period;
134     my %action_by_tag;
135     my %action_by_visit;
136     my %action_by_visit_number;
137     my %actions_per_visit_boolean;
138     my %hits_by_day;
139     my %hits_by_item;
140     my %hits_by_page;
141     my %hits_by_period;
142     my %hits_by_session;
143     my %last_access;
144     my %session_by_order;
145     my %session_by_page;
146     my %visit_by_aff;
147     my %visit_by_aff_by_day;
148     my %visit_by_aff_by_period;
149     my %visit_by_day;
150     my %visit_by_ip;
151     my %visit_by_period;
152     my %visit_by_session;
153     my %visit_by_user;
154     my %visit_number;
155
156
157
158         my $donelines = 0;
159
160         ## To fudge around break
161         my $saved_line;
162         my $recall;
163
164         COUNT:
165         while (<REPORT>) {
166                 chop;
167
168                 ## To fudge around break, so that we can break then recall
169                 ## the line where we broke
170                 if($recall) {
171                         $saved_line = $_;
172                         $_ = $recall;
173                         undef $recall;
174                 }
175                 my $line = [ split /\t/, $_ , 7];
176
177                 my $per = substr($line->[0], 0, $len);
178                 $break_check->($per)
179                         and do {
180                                 $recall = $_;
181                                 last COUNT;
182                         };
183                 next if $affiliate and $line->[5] ne $affiliate;
184                 my $update_visit;
185                 my $interval;
186                 $hits++;
187                 $hits_by_period{$per}++;
188                 $hits_by_day{$line->[0]}++;
189                 $hits_by_session{$line->[1]}++
190                         or $update_visit = 1;
191                 
192                 $interval = $line->[4] - $last_access{$line->[1]}
193                         if  $last_access{$line->[1]};
194                 if($interval) {
195                         $max_interval = $interval 
196                                 if $interval > $max_interval;
197                         $min_interval = $interval 
198                                 if $interval < $min_interval;
199                         $interval_total += $interval;
200                         $interval_count++;
201                         $update_visit = 1 if $interval > $timeout;
202                 }
203                 $last_access{$line->[1]} = $line->[4];
204
205                 if($update_visit) {
206                         $visits++;
207                         $visit_number = "$line->[1]:" . $visit_by_session{$line->[1]}++;
208                         $visit_by_period{$per}++;
209                         $visit_by_day{$line->[0]}++;
210                         $visit_by_user{$line->[2]}++;
211                         $visit_by_ip{$line->[3]}++;
212                         $visit_by_aff{$line->[5]}++;
213                         $visit_by_aff_by_period{$per}{$line->[5]}++;
214                         $visit_by_aff_by_day{$line->[0]}{$line->[5]}++;
215                 }
216
217                 # Leave this at & instead of UrlJoiner because of Vend::Track
218                 my (@items) = split /(?:^|&)([A-Z]+)=/, $line->[6];
219                 shift @items;
220 #::logDebug("items = " . ::uneval(\@items)) if $line->[6] =~ / \& /;
221                 while (@items) {
222                         my($tag, $val) = splice(@items, 0, 2);
223                         $action_by_visit{$tag}++
224                                 unless $action_by_visit_number{$visit_number}{$tag}++;
225                         $action_by_tag{$tag}{$val}++;
226                         $action_by_aff{$line->[5]}{$tag}++;
227                         $action_by_period{$per}{$tag}++;
228                         $action_by_day{$line->[0]}{$tag}++;
229                 }
230
231                 ## To fudge around break
232                 if($saved_line) {
233                         $_ = $saved_line;
234                         undef $saved_line;
235                         redo COUNT;
236                 }
237         }
238 #::logDebug("action_by_visit=" . ::uneval(\%action_by_visit));
239         foreach my $one (sort keys %visit_by_period) {
240                 my ($yr, $mon, $day) = $one =~ /(\d\d\d\d)(\d\d)(\d\d)?/;
241                 my $date;
242                 my %output;
243                 push @out, "<TR class=rnorm>\n";
244                 $date = $day ? "$names{$mon} $day, $yr" : "$names{$mon} $yr";
245                 $output{date} = <<EOF;
246 <TD VALIGN="top">
247 $date
248 </TD>
249 EOF
250                 my (@number) = grep /\S/, keys %{ $visit_by_aff_by_period{$one} };
251                 my $count = scalar(@number);
252                 $output{affiliate} = <<EOF;
253 <TD VALIGN="top" ALIGN=CENTER>
254 $count
255 </TD>
256 EOF
257
258                 $output{visits} = <<EOF;
259 <TD VALIGN="top" ALIGN=CENTER>
260 $visit_by_period{$one}
261 </TD>
262 EOF
263
264                 $output{hits} = <<EOF;
265 <TD VALIGN="top" ALIGN=CENTER>
266 $hits_by_period{$one}
267 </TD>
268 EOF
269                 for(qw/ VIEWPAGE VIEWPROD ADDITEM ORDER /) {
270                         $count = $action_by_period{$one}{$_} || 0;
271                         my $pct = '';
272                         $pct = $action_by_visit{$_} / $visit_by_period{$one} * 100
273                                 if $visit_by_period{$one};
274                         $pct = $pct <= 0 ? '' : sprintf( "<FONT SIZE=1><BR>%.2f%%</FONT>", $pct);
275                         $output{$hmap{$_}} = <<EOF;
276 <TD VALIGN="top" ALIGN=CENTER>
277 $count$pct
278 </TD>
279 EOF
280                 }
281                 for(@cols) {
282                         push @out, $output{$_};
283                 }
284                 push @out, '</TR>';
285         }
286         
287         redo BREAK unless $done or eof(REPORT);
288   }
289   push @out, <<EOF;
290 <tr class=rborder height=1><td colspan=8></td></tr>
291 </TABLE>
292 EOF
293   return join "\n", @out;
294 }
295 EOR