Simple Perl CGI shopping list

| June 23, 2017 | Updated: March 14, 2020

In my family we often used pieces of paper to write down a list for the next grocery store visit.
In most cases those papers were used to pass a list of necessary purchases from my wife to me, but also they could be used by one person to write down all necessities before shopping.
I think this is a common situation and many people use such lists.

Actually, we used small square stickers and stuck them on the fridge.

After some time I began to feel some inconvenience because sometimes I forgot to take these lists to the grocery or I couldn’t understand a handwriting.

So I decided to do a simple web service on my own web server, that will serve as a shopping list.

CGI shopping list

I believe, there are already some similar services. I believe they have nice web interfaces and dedicated android/ios apps. Probably some of them are free at least in the basic configuration. But I am not interested in them 🙂

I wanted my own, secure, private, reliable service with minimal IP traffic requirements.

By the way, have you ever seen a SOAP request carrying, for example, an array of 10 digits? I have seen such 500KB monster in SOAP::Lite/OTRS and that is why I am afraid of any apps with unknown protocols. I pay for each MB in my cell phone plan and want to reduce traffic consumption.

I have created a simple CGI Perl script. I tried to use in this script as less external modules as possible, although it might not be considered as a good idea by some people. Also I used MySQL backend for this project, because it is very convenient to me – to use a database, although for the simplicity I had to use a text file backend.

This script is used for very simple web page, containing only one <textarea> field and two <button>s. This page has no its own html or template file and described inside of the script.

shoppinglist.cgi 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139

#! /usr/bin/perl
 
use strict;
use utf8;
use DBI;
 
# actually I do not use this feature in the script
# but MySQL prior to version 5.6 did not allow ON UPDATE CURRENT_TIMESTAMP for a DATETIME field
# so I had to form and update date by myself
my $curtime = do {
    my ($s,$m,$h,$D,$M,$Y)=localtime;
    $Y+=1900;
    $M++;
"$Y-$M-$D $h:$m:$s" };
 
# 'dispatcher'
# which shopping list do we use
my $target = $ENV{REQUEST_URI};
# each list has it's own, filename for download etc
# all lists are stored in the same table but has a different key string to distinguish them
my ($dbkey, $cgifilename, $dwfilname, $title) = do{
    if( $ENV{REQUEST_URI} =~ m[/my_list_one.pl(\?|$)] ){
        ('list1', 'list1.pl', 'list1_shopping.txt', 'Grocery list')
    }elsif( $ENV{REQUEST_URI} =~ m[/auchan.pl(\?|$)] ){
        ('list2', 'list2.pl', 'list2_shopping.txt', 'Auchan list')
    }
    else{
        die "undetermined source of the request, exiting \n";
    }
};
 
# analyse cgi params by ourselves
# do not want to use CGI module for a few strings
my $request_string 	= '';
my %CGI_PARAMS 		= ();
 
read(STDIN, $request_string, $ENV{CONTENT_LENGTH})		if $ENV{REQUEST_METHOD} eq 'POST';
$request_string = $ENV{QUERY_STRING} 				if $ENV{REQUEST_METHOD} eq 'GET';
 
my @cgi_pairs = split(/&/, $request_string);
foreach my $pair (@cgi_pairs) {
    my ($name, $value) = split(/=/, $pair);
    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 
    $CGI_PARAMS{$name} = $value;
}
 
# perform tag replacements by ourselves
# do not want to use HTML::Entities for a simple replacement
my %replacements = (
    '"'	    => '&quot;',
    '\''    => '&#39;',
    '>'	    => '&gt;',
    '<'	    => '&lt;',
);	
 
my $dbh = DBI->connect(
                    'DBI:mysql:shopping:localhost',
                    'username',
                    'password',
                    {
                        RaiseError          => 0,
                        AutoCommit          => 1,
                        mysql_enable_utf8   => 1
                    }) or die "Unable to connect to db\n";
$dbh->do("SET NAMES UTF8");
 
# texarea have come back so we have to write her data and display the result
if( $CGI_PARAMS{'wrlist'} ){
    my $new_list = $CGI_PARAMS{'wrlist'};
    decode_entities( $new_list );
    my $statement = "INSERT INTO shoppinglist (rec_date, rec_list, rec_target) VALUES (?,?,?)";
    $dbh->do($statement, undef, $curtime, $new_list, $dbkey);
 
    my ($date, $list) = $dbh->selectrow_array("SELECT rec_date, rec_list FROM shoppinglist WHERE rec_target = '$dbkey'  ORDER BY rec_id DESC LIMIT 1");
    print "Status: 301 Moved Permanently\nLocation: https://koshka.ddns.net/myshoppinglist/$cgifilename\n\n"; # PRG pattern
}
elsif( $CGI_PARAMS{'downloadlist'} ){ # textarea's content should be downloaded as file
    my ($date, $list) = $dbh->selectrow_array("SELECT rec_date, rec_list FROM shoppinglist WHERE rec_target = '$dbkey'  ORDER BY rec_id DESC LIMIT 1");
    my $data = $date . "\r\n" . $list;
    use bytes;
    my $datalength = length($data);
    no bytes;
    print "Content-Type: application/text-html\nContent-Disposition: attachment; filename=$dwfilname\nContent-Transfer-Encoding: binary\nContent-Length: $datalength\n\n";
    print $data;
}
else{ 
    # no CGI parameters - returning current shoppinglist appropriate to the request uri
    my ($date, $list) = $dbh->selectrow_array("SELECT rec_date, rec_list FROM shoppinglist  WHERE rec_target = '$dbkey' ORDER BY rec_id DESC LIMIT 1");
    send_page($date, $list);
}
 
 
 
sub send_page{
	my ($date, $curr_list) = @_;
	my $header = "Content-type: text/html\n\n";
 
	encode_entities($curr_list);
 
	my $body  = '<!DOCTYPE html>
		<html>
			<head>
				<meta charset="utf-8">
				<title>'.$title.'</title>
			</head>
			<body> 
				<script language="javascript">
					function updatelist() {document.getElementById("myShopForm").submit();} 
					function downloadlist() {document.getElementById("reqdownload").submit();}
				</script>
 
				<span style="font-weight:bold">' .$date . '</span><br>
				<form method="POST" id="myShopForm" name="myShopForm">
					<textarea cols=50 rows=30 name="wrlist">' . $curr_list . '</textarea>
				</form>
				<br>
				<button id="savebtn" onClick="updatelist()">Save</button> 
				<button id="downloadbtn" onClick="downloadlist()" style="margin-left:20px;">Download</button>
				<form id="reqdownload" method="GET" >
					<input type=hidden name=downloadlist value=1 id=downloadlist>
				</form>
			</body>
		</html>';  
	# we should use GET request for download because some mobile browsrs do not understand form POSTing for download (CM13 default browser)
	binmode STDOUT, ':utf8';
	print $header, $body;
 
}
 
 
 
sub encode_entities{
	$_[0] =~ s/$_/$replacements{$_}/gm  foreach keys %replacements;
}
 
sub decode_entities{
	$_[0] =~ s/$replacements{$_}/$_/gm  foreach keys %replacements;
}

This project implies that you can create a number of shopping lists.
Each shopping-list, of course, must has its own http file name and by this name it will be distinguished by the script.

For example, if you want to create two independent lists:
1) create the main list which name will be the name of the real backend script on your server
/var/www/myshopping/main_shoppinglist.pl
this file might be accessible from the outside world as http://your.server.com/myshopping/main_shoppinglist.pl
Of course, ‘dispatcher'(lines 21-30) must know the name ‘main_shoppinglist.pl’ and which database key it corresponds to.

2) to add one more list simply create a symlink near the main script, pointing to the main script.

ln -s ./new_shoplist.pl /main_shoppinglist.pl

Now, when you access new_shoplist in a browser – you actually call main_shoppinglist.pl but pass to it ‘new_shoplist.pl’ as a REQUEST_URI, so you should add proper credentials for this new list in the ‘dispatcher’.

Database for this project is simple, consist of one table and store all shopping history :). The rec_target column is used to distinguish different lists.

CREATE TABLE `shoppinglist` (
  `rec_id` INT(10) UNSIGNED NOT NULL,
  `rec_date` datetime NOT NULL,
  `rec_target` VARCHAR(16) NOT NULL,
  `rec_list` text
) ENGINE=InnoDB DEFAULT CHARSET=utf8;
 
ALTER TABLE `shoppinglist`
  ADD PRIMARY KEY (`rec_id`),
  ADD KEY `rec_target` (`rec_target`);
 
ALTER TABLE `shoppinglist`
  MODIFY `rec_id` INT(10) UNSIGNED NOT NULL AUTO_INCREMENT, AUTO_INCREMENT=1;

Any kind of sessions or locks at application level are not supported in this script. It is redundant complexity in my opinion.
I actually use this service for a few weeks and found it convenient. It works well on desktop Forefox/Chrome and even in Android 4.4.2 standard browser. It also worked in a few different Opera browsers for Android and Lineageos’ Jelly browser.