Convert README to Markdown for nice GitHub viewing
[interchange.git] / code / UserTag / history_scan.tag
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 history-scan Order   find exclude default
9 UserTag history-scan addAttr
10 UserTag history-scan Version 1.20
11 UserTag history-scan Routine <<EOR
12 my %var_exclude = ( qw/
13                 mv_credit_card_number 1
14                 mv_pc                 1
15                 mv_session_id         1
16                 expand                1
17                 collapse              1
18                 expandall             1
19                 collapseall           1
20                 /);
21
22 sub {
23         my ($find, $exclude, $default, $opt) = @_;
24         $default ||= $Vend::Cfg->{SpecialPage}{catalog};
25         my $ref = $Vend::Session->{History};
26
27         use vars qw/$CGI $Tag/;
28
29         $opt->{size_limit} ||= '1024';
30         unless ($ref) {
31                 return $default if $opt->{pageonly};
32                 return $Tag->area($default);
33         }
34         my ($hist, $href, $cgi);
35         $exclude = qr/$exclude/ if $exclude;
36         my $include;
37         $include = qr/$opt->{include}/ if $opt->{include};
38         for (my $i = $#$ref - abs($opt->{count}); $i >= 0; $i--) {
39                 next if $ref->[$i][0] eq 'expired';
40                 if ($exclude and $ref->[$i][0] =~ $exclude) {
41                         next;
42                 }
43                 if ($include and $ref->[$i][0] !~ $include) {
44                         next;
45                 }
46                 if($find) {
47                         next unless $ref->[$i][0] =~ /$find/;
48                 }
49                 ($href, $cgi) = @{$ref->[$i]};
50                 last;
51         }
52         unless ($href) {
53                 return $default if $opt->{pageonly};
54                 return $Tag->area($default);
55         }
56         $href =~ s|/+|/|g;
57         $href =~ s|^/||;
58         if ($opt->{pageonly}) {
59                 return $href;
60         }
61         my $form = '';
62         if($opt->{var_exclude}) {
63                 for(split /[\s,\0]+/, $opt->{var_exclude}) {
64                         $var_exclude{$_} = 1;
65                 }
66         }
67         for(grep !$var_exclude{$_}, keys %$cgi) {
68                 $form .= "\n$_=";
69                 $form .= join("\n$_=", split /\0/, $cgi->{$_});
70         }
71         $form .= "\n$opt->{form}" if $opt->{form};
72         my $string = $Tag->area( {
73                                                                 href => $href,
74                                                                 form => $form,
75                                                                 no_session => $opt->{no_session},
76                                                         } );
77         my $len = length($string);
78         if($len > $opt->{size_limit}) {
79                 $len = $Tag->filter('commify.0', $len);
80                 my $m = errmsg(
81                                         'Huge URL (%s bytes) exceeds %s byte limit, returning blank.',
82                                         $len,
83                                         $opt->{size_limit},
84                                 );
85                 $Tag->error({ name => 'history-scan', set => $m })
86                         if $opt->{debug};
87                 return undef;
88         }
89         return $string;
90 }
91 EOR