rlm@37
|
1 #!/usr/bin/perl
|
rlm@37
|
2
|
rlm@37
|
3
|
rlm@37
|
4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
|
rlm@37
|
5 use Storable;
|
rlm@37
|
6 use CGI::Ajax;
|
rlm@37
|
7 use CGI qw(:standard);
|
rlm@37
|
8 use URI::Escape;
|
rlm@37
|
9 use MIME::QuotedPrint;
|
rlm@37
|
10 use MIME::Base64;
|
rlm@37
|
11 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
|
rlm@37
|
12 use XML::Simple;
|
rlm@37
|
13 use Data::Dumper;
|
rlm@37
|
14 $Data::Dumper::Indent = 1;
|
rlm@38
|
15 use Storable;
|
rlm@40
|
16 use SVG;
|
rlm@51
|
17 use Laserkard;
|
rlm@51
|
18
|
rlm@37
|
19
|
rlm@37
|
20 my $q = new CGI;
|
rlm@37
|
21
|
rlm@37
|
22
|
rlm@37
|
23
|
rlm@37
|
24 my %hash =
|
rlm@37
|
25 (
|
rlm@51
|
26 'material' => \&Laserkard::material,
|
rlm@51
|
27 'template' => \&Laserkard::template,
|
rlm@51
|
28 'inputbox' => \&Laserkard::inputbox,
|
rlm@51
|
29 'display' => \&Laserkard::display,
|
rlm@51
|
30 'change_rules' => \&Laserkard::change_rules,
|
rlm@51
|
31 'vanish' => \&Laserkard::vanish,
|
rlm@51
|
32 'updateForm' => \&Laserkard::updateForm,
|
rlm@51
|
33 'cardType' => \&Laserkard::cardType,
|
rlm@37
|
34 'echo' => \&echo
|
rlm@37
|
35 );
|
rlm@37
|
36
|
rlm@37
|
37
|
rlm@37
|
38
|
rlm@37
|
39 my $pjx = CGI::Ajax->new(%hash);
|
rlm@37
|
40
|
rlm@37
|
41 # this outputs the html for the page, and stops caching, so the fucker will work in IE.
|
rlm@37
|
42 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
|
rlm@37
|
43
|
rlm@37
|
44
|
rlm@37
|
45
|
rlm@37
|
46
|
rlm@37
|
47 sub gen
|
rlm@37
|
48 {
|
rlm@37
|
49
|
rlm@37
|
50
|
rlm@37
|
51
|
rlm@37
|
52
|
rlm@51
|
53
|
rlm@51
|
54 $a = Laserkard::genEcho();
|
rlm@51
|
55
|
rlm@37
|
56
|
rlm@37
|
57
|
rlm@37
|
58
|
rlm@37
|
59 return $a
|
rlm@37
|
60
|
rlm@37
|
61
|
rlm@37
|
62 }
|
rlm@37
|
63
|
rlm@37
|
64
|
rlm@37
|
65
|
rlm@37
|
66 sub echo
|
rlm@37
|
67 {
|
rlm@37
|
68
|
rlm@37
|
69
|
rlm@37
|
70
|
rlm@51
|
71 my $svg = shift;
|
rlm@37
|
72
|
rlm@37
|
73
|
rlm@37
|
74
|
rlm@51
|
75 #my $destination = 'rlm@mit.edu';
|
rlm@37
|
76
|
rlm@51
|
77
|
rlm@51
|
78
|
rlm@51
|
79
|
rlm@51
|
80
|
rlm@51
|
81
|
rlm@51
|
82
|
rlm@51
|
83 my @cards = split (/S3ntinEL/, $svg);
|
rlm@51
|
84 my $emmmm = shift;
|
rlm@51
|
85 #return $emmmm;
|
rlm@51
|
86
|
rlm@51
|
87 $cardsPerMail = 30;
|
rlm@51
|
88 ##### ok, now we have this awesome array with all the cards we need to print.
|
rlm@51
|
89 # the numbers are right, so now we really just have to impose them.
|
rlm@51
|
90 for $mails(0..int(($#cards) / $cardsPerMail))
|
rlm@51
|
91 {
|
rlm@51
|
92
|
rlm@51
|
93
|
rlm@51
|
94 my $start = $mails * $cardsPerMail;
|
rlm@51
|
95
|
rlm@51
|
96 my $end = ($#cards >($start + $cardsPerMail)) ? ($start + $cardsPerMail) : $#cards;
|
rlm@51
|
97
|
rlm@51
|
98 $svg = &impose(@cards[$start..$end]);
|
rlm@51
|
99 #$svg = &impose($cards[$end]);
|
rlm@51
|
100
|
rlm@51
|
101 &mail($svg, $emmmm);
|
rlm@51
|
102 }
|
rlm@51
|
103
|
rlm@51
|
104
|
rlm@52
|
105 #return "Success";
|
rlm@52
|
106 return "<h1>Success!</h1><br>".(int(($#cards) / $cardsPerMail)+1). " email(s) <br>Succesuffuly sent to : $emmmm<br>".($#cards+1). " cards were included in the SVG file(s).";
|
rlm@51
|
107
|
rlm@51
|
108
|
rlm@51
|
109
|
rlm@51
|
110
|
rlm@37
|
111
|
rlm@37
|
112 }
|
rlm@37
|
113
|
rlm@37
|
114
|
rlm@40
|
115
|
rlm@40
|
116 sub impose
|
rlm@40
|
117 {
|
rlm@40
|
118
|
rlm@40
|
119 #here $svg is a string which contains the properly formatted svg data for one card
|
rlm@40
|
120 #out purpose here is to take that one card, size it correctly, and make appropiate copies
|
rlm@40
|
121 #so that our supplier can simply import the file and print.
|
rlm@40
|
122
|
rlm@51
|
123 my $xml = new XML::Simple;
|
rlm@51
|
124 my @cards = @_;
|
rlm@51
|
125
|
rlm@51
|
126
|
rlm@51
|
127 for (0..$#cards)
|
rlm@51
|
128 {
|
rlm@51
|
129
|
rlm@51
|
130 $cards[$_] =~ s/^/\n\n\n/;
|
rlm@51
|
131 $cards[$_] =~ s/$/\n\n\n/;
|
rlm@40
|
132 # you fucking bitch!
|
rlm@51
|
133 $cards[$_] =~ s/Created wit........//;
|
rlm@51
|
134 }
|
rlm@40
|
135
|
rlm@40
|
136 # read XML file
|
rlm@51
|
137
|
rlm@51
|
138
|
rlm@51
|
139
|
rlm@51
|
140
|
rlm@51
|
141 #print Dumper(%juzz);
|
rlm@51
|
142
|
rlm@51
|
143
|
rlm@51
|
144 my $svg= SVG->new(width=>"18in",height=>"14in");
|
rlm@51
|
145
|
rlm@51
|
146 #print Dumper($juzz{'path'}[2]);
|
rlm@51
|
147 #print "\n***************************\n";
|
rlm@51
|
148 #print Dumper($pathData);
|
rlm@51
|
149
|
rlm@51
|
150
|
rlm@51
|
151
|
rlm@51
|
152
|
rlm@51
|
153 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
|
rlm@51
|
154
|
rlm@51
|
155
|
rlm@51
|
156 my @cardCollection;
|
rlm@51
|
157
|
rlm@51
|
158 for $name(0..$#cards) #22 letters for 22 cards
|
rlm@51
|
159 {
|
rlm@51
|
160
|
rlm@51
|
161 #calcuate the thing's place in the grid:
|
rlm@51
|
162
|
rlm@51
|
163 $cardsToARow = 5;
|
rlm@51
|
164 $cardsToAColumn = 5;
|
rlm@51
|
165
|
rlm@51
|
166 my $row = int($name/$cardsToARow); # cards to a row
|
rlm@51
|
167 my $column = int($name % $cardsToAColumn);
|
rlm@51
|
168
|
rlm@51
|
169 $margin = 25;
|
rlm@51
|
170 $cardWidth = 514*0.6057;
|
rlm@51
|
171 $cardHeight = 317*0.6057;
|
rlm@51
|
172
|
rlm@51
|
173
|
rlm@51
|
174 $transX = 40 + ($margin + $cardWidth ) * $column;
|
rlm@51
|
175 $transY = 40 + ($margin + $cardHeight) * $row;
|
rlm@51
|
176
|
rlm@51
|
177
|
rlm@51
|
178
|
rlm@51
|
179 ${"group_".$name} =
|
rlm@51
|
180 $svg->group(
|
rlm@51
|
181 id => "group_".$name,
|
rlm@51
|
182 transform => "translate($transX,$transY),"."$base"
|
rlm@51
|
183 );
|
rlm@51
|
184
|
rlm@51
|
185 push @cardCollection, ${"group_".$name};
|
rlm@51
|
186 }
|
rlm@51
|
187
|
rlm@51
|
188
|
rlm@51
|
189
|
rlm@51
|
190
|
rlm@51
|
191
|
rlm@51
|
192
|
rlm@51
|
193
|
rlm@51
|
194
|
rlm@51
|
195
|
rlm@51
|
196 for ($i = 0; $i <= $#cardCollection; $i++)
|
rlm@51
|
197 {
|
rlm@51
|
198
|
rlm@51
|
199
|
rlm@51
|
200 my $data = $xml->XMLin($cards[$i], ForceArray => 1);
|
rlm@40
|
201
|
rlm@40
|
202
|
rlm@40
|
203 my %data = %$data;
|
rlm@40
|
204
|
rlm@40
|
205 my %juzz =
|
rlm@40
|
206 (
|
rlm@40
|
207
|
rlm@40
|
208 path => $data{'path'},
|
rlm@40
|
209 rect => $data{'rect'},
|
rlm@40
|
210 width =>"16in" ,
|
rlm@40
|
211 height =>"12in" ,
|
rlm@40
|
212 version =>"1.1",
|
rlm@40
|
213 xmlns =>"http://www.w3.org/2000/svg"
|
rlm@40
|
214
|
rlm@40
|
215 );
|
rlm@40
|
216
|
rlm@40
|
217
|
rlm@40
|
218 for $pathData(@{$juzz{'path'}})
|
rlm@40
|
219 {
|
rlm@40
|
220 $cardCollection[$i]->tag('path', %{$pathData});
|
rlm@40
|
221 }
|
rlm@40
|
222
|
rlm@40
|
223 for $pathData(@{$juzz{'rect'}})
|
rlm@40
|
224 {
|
rlm@40
|
225 $cardCollection[$i]->tag('rect', %{$pathData});
|
rlm@40
|
226 }
|
rlm@40
|
227
|
rlm@40
|
228
|
rlm@40
|
229 }
|
rlm@40
|
230
|
rlm@40
|
231
|
rlm@40
|
232
|
rlm@40
|
233 #my $tag = $svg->tag('path', $juzz{'path'});
|
rlm@40
|
234
|
rlm@40
|
235
|
rlm@40
|
236 #$tag = $svg->group(%attributes);
|
rlm@40
|
237
|
rlm@40
|
238
|
rlm@40
|
239 $output = $svg->xmlify;
|
rlm@40
|
240
|
rlm@40
|
241
|
rlm@40
|
242 $killCopyrigt = <<HERE;
|
rlm@40
|
243 <!--
|
rlm@40
|
244 Generated using the Perl SVG Module V2.49
|
rlm@40
|
245 by Ronan Oger
|
rlm@40
|
246 Info: http://www.roitsystems.com/
|
rlm@40
|
247 -->
|
rlm@40
|
248 HERE
|
rlm@40
|
249
|
rlm@40
|
250 $output =~ s/$killCopyrigt/\n/;
|
rlm@40
|
251
|
rlm@40
|
252 return $output;
|
rlm@40
|
253
|
rlm@40
|
254
|
rlm@40
|
255
|
rlm@40
|
256 }
|
rlm@40
|
257
|
rlm@40
|
258
|
rlm@37
|
259 sub repair_file
|
rlm@37
|
260 {
|
rlm@37
|
261
|
rlm@37
|
262
|
rlm@38
|
263 $sss = $_[0];
|
rlm@37
|
264
|
rlm@37
|
265
|
rlm@37
|
266
|
rlm@38
|
267 $sss =~ s/^/\n\n\n/;
|
rlm@38
|
268 $sss =~ s/$/\n\n\n/;
|
rlm@38
|
269 # you fucking bitch.
|
rlm@38
|
270 $sss =~ s/Created wit........//;
|
rlm@37
|
271
|
rlm@37
|
272
|
rlm@38
|
273 store \$sss, 'file';
|
rlm@37
|
274
|
rlm@37
|
275 # read XML file
|
rlm@38
|
276 $xml = new XML::Simple;
|
rlm@37
|
277 $data = $xml->XMLin($sss, ForceArray => 1);
|
rlm@37
|
278
|
rlm@37
|
279
|
rlm@37
|
280 my %data = %$data;
|
rlm@37
|
281
|
rlm@37
|
282 my %juzz =
|
rlm@37
|
283 (
|
rlm@37
|
284
|
rlm@37
|
285 path => $data{'path'},
|
rlm@37
|
286 rect => $data{'rect'},
|
rlm@37
|
287 width =>"16in" ,
|
rlm@37
|
288 height =>"12in" ,
|
rlm@37
|
289 version =>"1.1",
|
rlm@37
|
290 xmlns =>"http://www.w3.org/2000/svg"
|
rlm@37
|
291
|
rlm@37
|
292 );
|
rlm@37
|
293
|
rlm@37
|
294
|
rlm@37
|
295 $out = $xml->XMLout(\%juzz , RootName=>'svg');
|
rlm@37
|
296
|
rlm@37
|
297
|
rlm@37
|
298 my $fixed = <<HERE;
|
rlm@37
|
299 <?xml version="1.0" standalone="no"?>
|
rlm@37
|
300 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
|
rlm@37
|
301 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
|
rlm@37
|
302 HERE
|
rlm@37
|
303
|
rlm@37
|
304
|
rlm@37
|
305
|
rlm@37
|
306 $fixed .= $out;
|
rlm@37
|
307
|
rlm@37
|
308 #print $fixed;
|
rlm@38
|
309 return $fixed;
|
rlm@37
|
310
|
rlm@37
|
311 }
|
rlm@37
|
312
|
rlm@37
|
313
|
rlm@37
|
314
|
rlm@37
|
315 sub mail
|
rlm@37
|
316 {
|
rlm@37
|
317
|
rlm@37
|
318
|
rlm@37
|
319
|
rlm@37
|
320 %mail =
|
rlm@37
|
321 (
|
rlm@37
|
322 from => 'rlm@mit.edu',
|
rlm@37
|
323 to => $_[1],
|
rlm@37
|
324 subject => 'Test attachment',
|
rlm@37
|
325 );
|
rlm@37
|
326
|
rlm@37
|
327
|
rlm@37
|
328 $boundary = "====" . time() . "====";
|
rlm@37
|
329 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
|
rlm@37
|
330
|
rlm@37
|
331 $message = encode_qp( "email from your friend PERL." );
|
rlm@37
|
332
|
rlm@37
|
333 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
|
rlm@37
|
334
|
rlm@37
|
335 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
|
rlm@37
|
336
|
rlm@37
|
337
|
rlm@37
|
338
|
rlm@37
|
339
|
rlm@37
|
340
|
rlm@37
|
341 $boundary = '--'.$boundary;
|
rlm@37
|
342 $mail{body} = <<END_OF_BODY;
|
rlm@37
|
343 $boundary
|
rlm@37
|
344 Content-Type: text/plain; charset="iso-8859-1"
|
rlm@37
|
345 Content-Transfer-Encoding: quoted-printable
|
rlm@37
|
346
|
rlm@37
|
347 $message
|
rlm@37
|
348 $boundary
|
rlm@37
|
349 Content-Type: application/octet-stream; name="test.svg"
|
rlm@37
|
350 Content-Transfer-Encoding: base64
|
rlm@37
|
351 Content-Disposition: attachment; filename="test.svg"
|
rlm@37
|
352
|
rlm@37
|
353 $attach1
|
rlm@37
|
354
|
rlm@37
|
355
|
rlm@37
|
356 $boundary--
|
rlm@37
|
357
|
rlm@37
|
358 END_OF_BODY
|
rlm@37
|
359
|
rlm@37
|
360 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
|
rlm@37
|
361
|
rlm@37
|
362
|
rlm@37
|
363 }
|
rlm@37
|
364
|
rlm@37
|
365
|
rlm@37
|
366
|
rlm@37
|
367
|
rlm@37
|
368
|
rlm@37
|
369
|
rlm@37
|
370
|
rlm@37
|
371
|
rlm@37
|
372
|
rlm@37
|
373
|
rlm@37
|
374
|
rlm@37
|
375
|
rlm@37
|
376
|
rlm@37
|
377
|