Subversion Repositories CoffeeCatalog

Rev

Rev 7 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 7 Rev 9
Line 1... Line 1...
1 
#!/usr/bin/perl -w
 1 
#!/usr/bin/perl -w
Line 2... Line 2...
2 
 
 2 
 
3 
use strict;
 3 
use strict;
4 
use HTML::Tiny;
 - 
 
5 
#use CGI qw(:standard escape escapeHTML);
 4 
use HTML::Tiny;
6 
use CGI qw/param cookie header start_html url/;
 - 
 
7 
 
 5 
use CGI qw/param header start_html url uploadInfo/;
Line 8... Line 6...
8 
my $h = HTML::Tiny->new( mode => 'html' );
 6 
my $h = HTML::Tiny->new( mode => 'html' );
9 
 
 7 
 
- 
 
 8 
 
10 
 
 9 
my $pageTitle = "CC Manage Roaster";
11 
my $pageTitle = "CC Manage Roaster";
 10 
my $homeURL = "/";
12 
my $homeURL = "/";
 11 
my $DBTable = "roasters";
13 
my %FIELDS = (
 12 
my %FIELDS = (
14 
	roaster   =>  [qw(Roaster                  1		text			required)],
 13 
	roaster   =>  [qw(Roaster                       1		text			required)],
15 
	url       =>  [qw(URL                      2		text			required)],
 14 
	url       =>  [qw(URL                           2		text			required)],
16 
	location  =>  ['Location (City, State)',   3,		'text',			'required'],
 15 
	location  =>  ['Location (City, State)',   3,	'text',			'required'],
- 
 
 16 
	note      =>  [qw(Notes                         4		textarea)],
17 
	note      =>  [qw(Notes                    4		textarea)],
 17 
	logo      =>  [qw(Logo                          5		image)]
18 
	logo      =>  [qw(Logo                     5		image)]
 18 
);
19 
);
 19 
 
20 
my %fieldDisplayName = map  { $_ => $FIELDS{$_}->[0]   } keys %FIELDS;
 20 
my %fieldDisplayName = map  { $_ => $FIELDS{$_}->[0]   } keys %FIELDS;
- 
 
 21 
my %fieldType        = map  { $_ => $FIELDS{$_}->[2]   } keys %FIELDS;
Line 21... Line 22...
21 
my %fieldType        = map  { $_ => $FIELDS{$_}->[2]   } keys %FIELDS;
 22 
my @requiredFields   = sort fieldOrder grep { defined $FIELDS{$_}->[3] } keys %FIELDS;
22 
my @requiredFields   = sort fieldOrder grep { defined $FIELDS{$_}->[3] } keys %FIELDS;
 23 
my @DBFields   = sort fieldOrder grep { $fieldType{$_} =~ /^text/ } keys %FIELDS;
23 
#my @requiredFields   = grep { $FIELDS{$_}->[2] eq 'required' } keys %FIELDS;
 24 
my $primary = $DBFields[0];
Line -... Line 25...
- 
 
 25 
 
- 
 
 26 
sub fieldOrder {
- 
 
 27 
	$FIELDS{$a}->[1] <=> $FIELDS{$b}->[1];
- 
 
 28 
}
- 
 
 29 
 
- 
 
 30 
sub saveForm {
- 
 
 31 
  my $FTS = shift;
- 
 
 32
- 
 
 33 
  use WebDB;
- 
 
 34 
  my $dbh = WebDB::connect ();
- 
 
 35 
  if ($FTS->{logo}) {
- 
 
 36 
    use Image::Magick;
- 
 
 37 
    my $mime_type = uploadInfo ($FTS->{logo})->{'Content-Type'};
- 
 
 38 
    my ($full, $thumb) = read_image_file ($FTS->{logo});
- 
 
 39 
    $dbh->do (
- 
 
 40 
  		  "INSERT INTO $DBTable
- 
 
 41 
		    (roaster,url,logo,thumbnail,location,note,mime_type,date_added)
- 
 
 42 
		    VALUES(?,?,?,?,?,?,?,now())
- 
 
 43 
		    ON DUPLICATE KEY UPDATE url = ?, logo = ?, thumbnail = ?, location = ?, note = ?, mime_type = ?",
- 
 
 44 
			   undef,
- 
 
 45 
			   $FTS->{roaster}, $FTS->{url}, $full, $thumb, $FTS->{location}, $FTS->{note}, $mime_type,
- 
 
 46 
			                    $FTS->{url}, $full, $thumb, $FTS->{location}, $FTS->{note}, $mime_type);
- 
 
 47 
  } else {
- 
 
 48 
    $dbh->do (
- 
 
 49 
  		  "INSERT INTO $DBTable
- 
 
 50 
		    (roaster,url,location,note,date_added)
- 
 
 51 
		    VALUES(?,?,?,?,now())
- 
 
 52 
		    ON DUPLICATE KEY UPDATE url = ?, location = ?, note = ?",
- 
 
 53 
			   undef,
- 
 
 54 
			   $FTS->{roaster}, $FTS->{url}, $FTS->{location}, $FTS->{note}, $FTS->{url}, $FTS->{location}, $FTS->{note});
- 
 
 55 
  }
- 
 
 56 
	$dbh->disconnect ();	 # Image was stored into database successfully.
24 
 
 57 
}
25 
sub fieldOrder {
 58 
 
Line 26... Line 59...
26 
	$FIELDS{$a}->[1] <=> $FIELDS{$b}->[1];
 59 
 
27 
}
 60 
 
28 
 
 61 
 
29 
print header (),
 62 
print header (),
Line 41... Line 74...
41 
]);
 74 
]);
Line 42... Line 75...
42 
 
 75 
 
43 
my $choice = param ("choice") // "";
 76 
my $choice = param ("choice") // "";
44 
if ($choice eq "Save") {
 77 
if ($choice eq "Save") {
45 
	process_form ();
 78 
	process_form ();
46 
} elsif (defined (param ("roaster"))) {
 79 
} elsif (defined (param ($primary))) {
47 
  my $roaster = param ("roaster");
 80 
  my $thing = param ($primary);
48 
	display_form ($roaster, $choice);
 81 
	display_form ($thing, $choice);
49 
} else {
 82 
} else {
50 
	display_form (); # blank form
 83 
	display_form (); # blank form
Line 51... Line 84...
51 
}
 84 
}
Line 52... Line -...
52 
 
 - 
 
53 
print $h->close ("html");
 85 
 
54 
 
 86 
print $h->close ("html");
55 
 
 87 
 
- 
 
 88 
sub display_form  {
56 
sub display_form  {
 89 
  my $R = shift;
57 
  my $R = shift;
 90 
  my $view = shift // "";
Line 58... Line 91...
58 
  my $view = shift // "";
 91 
  my %F;
59 
  my $hiddenR = "";
 92 
  my $hiddenR = "";
60 
	my $actionbutton;
 93 
	my $actionbutton;
61
94
62 
  my ($U, $L, $I, $N, $logo);
 95 
	my ($I, $logo);
63
96
- 
 
 97 
  if ($R) {
64 
  if ($R) {
 98 
    # we're dealing with an existing thing.  Get the current values out of the DB...
65 
    # we're updating an existing roaster.  Get the current values out of the DB...
 99 
    use WebDB;
66 
    use WebDB;
 100 
    my $dbh = WebDB::connect ();
67 
    my $dbh = WebDB::connect ();
 101
- 
 
 102 
	  @F{@DBFields} = $dbh->selectrow_array (
68 
	  ($U, $L, $N) = $dbh->selectrow_array (
 103 
                     "SELECT ". join (", ", @DBFields) ." FROM $DBTable WHERE $primary = ?",
69 
                     "SELECT url, location, note FROM roasters WHERE roaster = ?",
 104 
                      undef, $R);
- 
 
 105 
	  $dbh->disconnect ();
Line 70... Line 106...
70 
                      undef, $R);
 106
71 
	  $dbh->disconnect ();
 107 
	  my $i = "serve_image.pl" . sprintf ("?roaster=%s", $h->url_encode ($R));
Line 72... Line 108...
72 
	  my $i = "serve_image.pl" . sprintf ("?name=%s", $h->url_encode ($R));
 108 
	  $I = $h->img ({ src => "$i;thumbnail=1", class=>"show", alt => $R });
73 
	  $I = $h->img ({ src => "$i;thumbnail=1", alt => $R });
 109 
	  $I .= $h->img ({ src => "$i", class=>"hide", alt => $R });
74
110
- 
 
 111 
	  # did we find a record?
75 
	  # did we find a record?
 112 
	  error ("Cannot find a database entry for '$R'") unless defined $F{$DBFields[0]};
76 
	  error ("Cannot find Roaster named $R") unless defined ($L);
 113 
 
77 
 
 114 
    if ($view eq "Update") {
78 
    if ($view eq "Update") {
 115 
      # We'd like the update that thing, give the user a form...
Line 79... Line 116...
79 
      print $h->p ("Updating Roaster $R...");
 116 
      print $h->p ("Updating ".ucfirst ($primary).": $R...");
80 
      $R = formField ('roaster', $R);
 117
81 
      $U = formField ('url', $U);
 118 
      foreach (@DBFields) {
- 
 
 119 
        $F{$_} = formField ($_, $F{$_});
82 
      $L = formField ('location', $L);
 120 
      }
83 
      $N = formField ('note', $N);
 121 
      $logo = $I.'&nbsp;&nbsp;&nbsp;' . formField ('logo');
84 
      $logo = $I.'&nbsp;&nbsp;&nbsp;' . formField ('logo');
 122
85
123 
      $actionbutton = formField ("choice", "Save");
- 
 
 124 
      $actionbutton .= formField ("Cancel");
86 
      $actionbutton = formField ("choice", "Save");
 125 
    } else {
87 
      $actionbutton .= formField ("choice", "Cancel");
 126 
      # We're just looking at it...
88 
    } else {
 127 
      print $h->p ("Viewing ".ucfirst ($primary).": $R...");
Line 89... Line 128...
89 
      print $h->p ("Viewing Roaster $R...");
 128 
      $logo = $I;
90 
      $logo = $I;
 129 
      $F{$DBFields[0]} .= $h->input ({ type=>"hidden", name=>$DBFields[0], value=> $F{$DBFields[0]} });
91 
      $hiddenR = $h->input ({ type=>"hidden", name=>"roaster", value=> "$R" });
 - 
 
92 
      $actionbutton = formField ("choice", "Update");
 130 
      $actionbutton = formField ("choice", "Update");
93 
    }
 131 
      $actionbutton .= formField ("Cancel", "Back");
Line 94... Line 132...
94 
  } else {
 132 
    }
- 
 
 133 
  } else {
95 
    print $h->p ("Adding a new Roaster...");
 134 
    print $h->p ("Adding a new ".ucfirst ($primary)."...");
Line 96... Line 135...
96 
 
 135 
 
97 
    $R = formField ('roaster');
 136 
    foreach (@DBFields) {
98 
    $U = formField ('url');
 137 
      $F{$_} = formField ($_);
99 
    $L = formField ('location');
 - 
 
100 
    $N = formField ('note');
 - 
 
101 
    $logo = formField ('logo');
 - 
 
102
138 
    }
103 
    $actionbutton = formField ("choice", "Save");
 139 
    $logo = formField ('logo');
104 
  }
 140
105
141 
    $actionbutton = formField ("choice", "Save");
106
- 
 
107 
	print $h->open ("form", { action => url (), method=>"POST", enctype=>"multipart/form-data" });
 - 
 
108 
	print $h->div ({ class=>"rTable" }, [
 - 
 
109 
    $h->div ({ class=>"rTableRow" }, [
 142 
    $actionbutton .= formField ("Cancel");
110 
      $h->div ({ class=>"rTableCell right" }, "$fieldDisplayName{'roaster'}: "),
 143 
  }
111 
      $h->div ({ class=>"rTableCell" }, [ $hiddenR, $R ])
 144
112 
    ]),
 145
113 
    $h->div ({ class=>"rTableRow" }, [
 146 
	print $h->open ("form", { action => url (), method=>"POST", enctype=>"multipart/form-data" });
114 
      $h->div ({ class=>"rTableCell right" }, "$fieldDisplayName{'url'}: "),
 - 
 
115 
      $h->div ({ class=>"rTableCell" }, $U)
 - 
 
116 
    ]),
 - 
 
117 
    $h->div ({ class=>"rTableRow" }, [
 147 
	print $h->div ({ class=>"sp0" },
118 
      $h->div ({ class=>"rTableCell right" }, "$fieldDisplayName{'location'}: "),
 148 
	  $h->div ({ class=>"rTable" }, [ map ({
Line 119... Line 149...
119 
      $h->div ({ class=>"rTableCell" }, $L)
 149 
      $h->div ({ class=>"rTableRow" }, [
120 
    ]),
 150 
        $h->div ({ class=>"rTableCell right top" }, "$fieldDisplayName{$_}: "),
Line 121... Line 151...
121 
    $h->div ({ class=>"rTableRow" }, [
 151 
        $h->div ({ class=>"rTableCell" }, $F{$_})
Line 145... Line 175...
145 
  	} else {
 175 
  	} else {
146 
	  	$FORM{$_} = param ($_) // "";
176 
	  	$FORM{$_} = param ($_) // "";
147 
  	}
 177 
  	}
148 
  }
 178 
  }
Line 149... Line -...
149
- 
 
150 
  my $dbh;
 - 
 
151 
  my ($full, $thumb, $mime_type);
 - 
 
152 
  my $serve_url;
 - 
 
153
179
154 
  	 # check for required fields
 180 
  	 # check for required fields
155 
	my @errors = ();
 181 
	my @errors = ();
156 
	foreach (@requiredFields) {
 182 
	foreach (@requiredFields) {
157 
		push @errors, "$fieldDisplayName{$_} is missing." if $FORM{$_} eq "";
 183 
		push @errors, "$fieldDisplayName{$_} is missing." if $FORM{$_} eq "";
Line 164... Line 190...
164 
  	  $h->p ("Please click your Browser's Back button to\n"
 190 
  	  $h->p ("Please click your Browser's Back button to\n"
165 
  	  	   . "return to the previous page and correct the problem.")
 191 
  	  	   . "return to the previous page and correct the problem.")
166 
  	]);
 192 
  	]);
167 
  	return;
 193 
  	return;
168 
  }	 # Form was okay;  get image type and contents and create new record.
 194 
  }	 # Form was okay;  get image type and contents and create new record.
- 
 
 195 
 
- 
 
 196 
  saveForm (\%FORM);
Line 169... Line -...
169
- 
 
170 
  # Use REPLACE to clobber any old image with the same name.
 - 
 
171 
  $dbh = WebDB::connect ();
 - 
 
172 
  if ($FORM{logo}) {
 - 
 
173 
    $mime_type = uploadInfo ($FORM{logo})->{'Content-Type'};
 - 
 
174 
    ($full, $thumb) = read_image_file ($FORM{logo});
 - 
 
175 
    $dbh->do (
 - 
 
176 
  		  "REPLACE INTO roasters
 - 
 
177 
		    (roaster,url,logo,thumbnail,location,note,mime_type)
 - 
 
178 
		    VALUES(?,?,?,?,?,?,?)",
 - 
 
179 
			   undef,
 - 
 
180 
			   $FORM{roaster}, $FORM{url}, $full, $thumb, $FORM{location}, $FORM{note}, $mime_type);
 - 
 
181 
  } else {
 - 
 
182 
    $dbh->do (
 - 
 
183 
  		  "INSERT INTO roasters
 - 
 
184 
		    (roaster,url,location,note)
 - 
 
185 
		    VALUES(?,?,?,?)
 - 
 
186 
		    ON DUPLICATE KEY UPDATE url = ?, location = ?, note = ?",
 - 
 
187 
			   undef,
 - 
 
188 
			   $FORM{roaster}, $FORM{url}, $FORM{location}, $FORM{note}, $FORM{url}, $FORM{location}, $FORM{note});
 - 
 
189 
  }
 - 
 
190 
	$dbh->disconnect ();	 # Image was stored into database successfully.  Present confirmation
 - 
 
191 
		 # page that displays both the full size and thumbnail images.
 197
Line 192... Line 198...
192 
	print $h->p ({ class=>"success" }, "Roaster successfully saved.");
 198 
	print $h->p ({ class=>"success" }, ucfirst ($primary)." successfully saved.");
193 
 
 199 
 
Line 194... Line -...
194 
  display_form ($FORM{roaster});
 - 
 
195 
}
 200 
  display_form ($FORM{roaster});
196 
 
 201 
}
197 
use Image::Magick;
 202 
 
- 
 
 203 
sub read_image_file {
198 
sub read_image_file {
 204 
	my $fh = shift;             # filename/file handle
199 
	my $fh = shift;             # filename/file handle
 205 
	my $img = new Image::Magick;
200 
	my $img = new Image::Magick;
 206 
	my $fullimg = new Image::Magick;
201 
	my ($full, $thumb);
 207 
	my ($full, $thumb);
202 
	my $err;
 208 
	my $err;
203 
	# read full-size image directly from upload file
 209 
	# read full-size image directly from upload file
204 
	(read ($fh, $full, (stat ($fh))[7]) == (stat ($fh))[7])
 210 
	(read ($fh, $full, (stat ($fh))[7]) == (stat ($fh))[7])
205 
          or error ("Can't read image file: $!");
 211 
          or error ("Can't read image file: $!");
- 
 
 212 
	# produce thumbnail from full-size image
- 
 
 213 
	$err = $img->BlobToImage ($full);
- 
 
 214 
	error ("Can't convert image data: $err") if $err;
- 
 
 215 
	$err = $fullimg->BlobToImage ($full);
- 
 
 216 
	error ("Can't convert image data: $err") if $err;
- 
 
 217 
 
- 
 
 218 
 	if ($fullimg->Get("width") > 300 or $fullimg->Get("height") > 300) {
- 
 
 219 
	  $err = $fullimg->Scale (geometry => "300x300");
206 
	# produce thumbnail from full-size image
 220 
	  error ("Can't scale image file: $err") if $err;
207 
	$err = $img->BlobToImage ($full);
 221 
 	}
208 
	error ("Can't convert image data: $err") if $err;
 222 
 
- 
 
 223 
	$err = $img->Scale (geometry => "64x64");
209 
	$err = $img->Scale (geometry => "64x64");
 224 
	error ("Can't scale image file: $err") if $err;
210 
	error ("Can't scale image file: $err") if $err;
 225 
	$thumb = $img->ImageToBlob ();
Line 211... Line 226...
211 
	$thumb = $img->ImageToBlob ();
 226 
	$full  = $fullimg->ImageToBlob ();
212 
	return ($full, $thumb);
 227 
	return ($full, $thumb);
Line 233... Line 248...
233 
        size => 60
 248 
        size => 60
234 
      }) . $h->label ({ for=>"file", class=>"top" }, $h->span ("Choose File..."));
 249 
      }) . $h->label ({ for=>"file", class=>"top" }, $h->span ("Choose File..."));
Line 235... Line 250...
235 
 
 250 
 
236 
	} elsif ($type eq "button") {
 251 
	} elsif ($type eq "button") {
237 
		if ($name eq "Cancel") {
 252 
		if ($name eq "Cancel") {
238 
			return $h->input ({ type=>"submit", value => "Cancel", onClick=>"history.back();" })
 253 
			return $h->input ({ type=>"button", value => $value ne '' ? $value : "Cancel" , onClick=>"history.back(); return false;" })
239 
		} else {
 254 
		} else {
240 
			return $h->input ({ type=>"submit", value => $value, name=>$name })
 255 
			return $h->input ({ type=>"submit", value => $value, name=>$name })
Line 241... Line 256...
241 
		}
 256 
		}