view echo.pl @ 77:bf68c9ea9528 laserkard

saving
author Robert McIntyre <rlm@mit.edu>
date Thu, 22 Jul 2010 09:30:45 -0400
parents 375225442677
children
line wrap: on
line source
1 #!/usr/bin/perl
4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
5 use Storable;
6 use CGI::Ajax;
7 use CGI qw(:standard);
8 use URI::Escape;
9 use MIME::QuotedPrint;
10 use MIME::Base64;
11 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
12 use XML::Simple;
13 use Data::Dumper;
14 $Data::Dumper::Indent = 1;
15 use Storable;
16 use SVG;
17 use Laserkard;
20 my $q = new CGI;
24 my %hash =
25 (
26 'material' => \&Laserkard::material,
27 'template' => \&Laserkard::template,
28 'inputbox' => \&Laserkard::inputbox,
29 'display' => \&Laserkard::display,
30 'change_rules' => \&Laserkard::change_rules,
31 'vanish' => \&Laserkard::vanish,
32 'updateForm' => \&Laserkard::updateForm,
33 'cardType' => \&Laserkard::cardType,
34 'echo' => \&echo
35 );
39 my $pjx = CGI::Ajax->new(%hash);
41 # this outputs the html for the page, and stops caching, so the fucker will work in IE.
42 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
47 sub gen
48 {
54 $a = Laserkard::genEcho();
59 return $a
62 }
66 sub echo
67 {
71 my $svg = shift;
75 #my $destination = 'rlm@mit.edu';
83 my @cards = split (/S3ntinEL/, $svg);
84 my $emmmm = shift;
85 #return $emmmm;
87 $cardsPerMail = 30;
88 ##### ok, now we have this awesome array with all the cards we need to print.
89 # the numbers are right, so now we really just have to impose them.
90 for $mails(0..int(($#cards) / $cardsPerMail))
91 {
94 my $start = $mails * $cardsPerMail;
96 my $end = ($#cards >($start + $cardsPerMail)) ? ($start + $cardsPerMail) : $#cards;
98 $svg = &impose(@cards[$start..$end]);
99 #$svg = &impose($cards[$end]);
101 &mail($svg, $emmmm);
102 }
105 #return "Success";
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).";
112 }
116 sub impose
117 {
119 #here $svg is a string which contains the properly formatted svg data for one card
120 #out purpose here is to take that one card, size it correctly, and make appropiate copies
121 #so that our supplier can simply import the file and print.
123 my $xml = new XML::Simple;
124 my @cards = @_;
127 for (0..$#cards)
128 {
130 $cards[$_] =~ s/^/\n\n\n/;
131 $cards[$_] =~ s/$/\n\n\n/;
132 # you fucking bitch!
133 $cards[$_] =~ s/Created wit........//;
134 }
136 # read XML file
141 #print Dumper(%juzz);
144 my $svg= SVG->new(width=>"18in",height=>"14in");
146 #print Dumper($juzz{'path'}[2]);
147 #print "\n***************************\n";
148 #print Dumper($pathData);
153 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
156 my @cardCollection;
158 for $name(0..$#cards) #22 letters for 22 cards
159 {
161 #calcuate the thing's place in the grid:
163 $cardsToARow = 5;
164 $cardsToAColumn = 5;
166 my $row = int($name/$cardsToARow); # cards to a row
167 my $column = int($name % $cardsToAColumn);
169 $margin = 25;
170 $cardWidth = 514*0.6057;
171 $cardHeight = 317*0.6057;
174 $transX = 40 + ($margin + $cardWidth ) * $column;
175 $transY = 40 + ($margin + $cardHeight) * $row;
179 ${"group_".$name} =
180 $svg->group(
181 id => "group_".$name,
182 transform => "translate($transX,$transY),"."$base"
183 );
185 push @cardCollection, ${"group_".$name};
186 }
196 for ($i = 0; $i <= $#cardCollection; $i++)
197 {
200 my $data = $xml->XMLin($cards[$i], ForceArray => 1);
203 my %data = %$data;
205 my %juzz =
206 (
208 path => $data{'path'},
209 rect => $data{'rect'},
210 width =>"16in" ,
211 height =>"12in" ,
212 version =>"1.1",
213 xmlns =>"http://www.w3.org/2000/svg"
215 );
218 for $pathData(@{$juzz{'path'}})
219 {
220 $cardCollection[$i]->tag('path', %{$pathData});
221 }
223 for $pathData(@{$juzz{'rect'}})
224 {
225 $cardCollection[$i]->tag('rect', %{$pathData});
226 }
229 }
233 #my $tag = $svg->tag('path', $juzz{'path'});
236 #$tag = $svg->group(%attributes);
239 $output = $svg->xmlify;
242 $killCopyrigt = <<HERE;
243 <!--
244 Generated using the Perl SVG Module V2.49
245 by Ronan Oger
246 Info: http://www.roitsystems.com/
247 -->
248 HERE
250 $output =~ s/$killCopyrigt/\n/;
252 return $output;
256 }
259 sub repair_file
260 {
263 $sss = $_[0];
267 $sss =~ s/^/\n\n\n/;
268 $sss =~ s/$/\n\n\n/;
269 # you fucking bitch.
270 $sss =~ s/Created wit........//;
273 store \$sss, 'file';
275 # read XML file
276 $xml = new XML::Simple;
277 $data = $xml->XMLin($sss, ForceArray => 1);
280 my %data = %$data;
282 my %juzz =
283 (
285 path => $data{'path'},
286 rect => $data{'rect'},
287 width =>"16in" ,
288 height =>"12in" ,
289 version =>"1.1",
290 xmlns =>"http://www.w3.org/2000/svg"
292 );
295 $out = $xml->XMLout(\%juzz , RootName=>'svg');
298 my $fixed = <<HERE;
299 <?xml version="1.0" standalone="no"?>
300 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
301 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
302 HERE
306 $fixed .= $out;
308 #print $fixed;
309 return $fixed;
311 }
315 sub mail
316 {
320 %mail =
321 (
322 from => 'rlm@mit.edu',
323 to => $_[1],
324 subject => 'Test attachment',
325 );
328 $boundary = "====" . time() . "====";
329 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
331 $message = encode_qp( "email from your friend PERL." );
333 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
335 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
341 $boundary = '--'.$boundary;
342 $mail{body} = <<END_OF_BODY;
343 $boundary
344 Content-Type: text/plain; charset="iso-8859-1"
345 Content-Transfer-Encoding: quoted-printable
347 $message
348 $boundary
349 Content-Type: application/octet-stream; name="test.svg"
350 Content-Transfer-Encoding: base64
351 Content-Disposition: attachment; filename="test.svg"
353 $attach1
356 $boundary--
358 END_OF_BODY
360 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
363 }