view echo.pl @ 46:26c2b3ad21c7 laserkard

[svn r47] saving progresswww.cinemassacre.com/new/?page_id=30
author rlm
date Sun, 31 Jan 2010 12:33:33 -0500
parents 1ac1409ea68c
children 95fa4bcc5d67
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;
18 my $q = new CGI;
22 my %hash =
23 (
24 'echo' => \&echo
25 );
29 my $pjx = CGI::Ajax->new(%hash);
31 # this outputs the html for the page, and stops caching, so the fucker will work in IE.
32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
37 sub gen
38 {
39 {
40 local( $/, *FH ) ;
41 open( FH, "<./echo.html" ) or die "sudden flaming death\n";
42 $a = <FH>;
43 }
45 {
46 local( $/, *FH ) ;
47 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
48 $b = <FH>;
49 }
53 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
57 return $a
60 }
64 sub echo
65 {
68 my $svg = $_[0];
70 my $destination = 'rlm@mit.edu';
75 $svg = &impose($svg);
81 &mail($svg, $destination);
86 return "done.";
88 }
92 sub impose
93 {
95 #here $svg is a string which contains the properly formatted svg data for one card
96 #out purpose here is to take that one card, size it correctly, and make appropiate copies
97 #so that our supplier can simply import the file and print.
99 $sss = $_[0];
100 $sss =~ s/^/\n\n\n/;
101 $sss =~ s/$/\n\n\n/;
102 # you fucking bitch!
103 $sss =~ s/Created wit........//;
106 # read XML file
107 my $xml = new XML::Simple;
108 my $data = $xml->XMLin($sss, ForceArray => 1);
111 my %data = %$data;
113 my %juzz =
114 (
116 path => $data{'path'},
117 rect => $data{'rect'},
118 width =>"16in" ,
119 height =>"12in" ,
120 version =>"1.1",
121 xmlns =>"http://www.w3.org/2000/svg"
123 );
128 #print Dumper(%juzz);
131 my $svg= SVG->new(width=>"18in",height=>"12in");
133 #print Dumper($juzz{'path'}[2]);
134 #print "\n***************************\n";
135 #print Dumper($pathData);
140 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
143 my @cardCollection;
145 for $name(0..21) #22 letters for 22 cards
146 {
148 #calcuate the thing's place in the grid:
150 $cardsToARow = 5;
151 $cardsToAColumn = 5;
153 my $row = int($name/$cardsToARow); # cards to a row
154 my $column = int($name % $cardsToAColumn);
156 $margin = 25;
157 $cardWidth = 514*0.6057;
158 $cardHeight = 317*0.6057;
161 $transX = 40 + ($margin + $cardWidth ) * $column;
162 $transY = 40 + ($margin + $cardHeight) * $row;
166 ${"group_".$name} =
167 $svg->group(
168 id => "group_".$name,
169 transform => "translate($transX,$transY),"."$base"
170 );
172 push @cardCollection, ${"group_".$name};
173 }
182 for ($i = 0; $i <= $#cardCollection; $i++)
183 {
185 for $pathData(@{$juzz{'path'}})
186 {
187 $cardCollection[$i]->tag('path', %{$pathData});
188 }
190 for $pathData(@{$juzz{'rect'}})
191 {
192 $cardCollection[$i]->tag('rect', %{$pathData});
193 }
196 }
200 #my $tag = $svg->tag('path', $juzz{'path'});
203 #$tag = $svg->group(%attributes);
206 $output = $svg->xmlify;
209 $killCopyrigt = <<HERE;
210 <!--
211 Generated using the Perl SVG Module V2.49
212 by Ronan Oger
213 Info: http://www.roitsystems.com/
214 -->
215 HERE
217 $output =~ s/$killCopyrigt/\n/;
219 return $output;
223 }
226 sub repair_file
227 {
230 $sss = $_[0];
234 $sss =~ s/^/\n\n\n/;
235 $sss =~ s/$/\n\n\n/;
236 # you fucking bitch.
237 $sss =~ s/Created wit........//;
240 store \$sss, 'file';
242 # read XML file
243 $xml = new XML::Simple;
244 $data = $xml->XMLin($sss, ForceArray => 1);
247 my %data = %$data;
249 my %juzz =
250 (
252 path => $data{'path'},
253 rect => $data{'rect'},
254 width =>"16in" ,
255 height =>"12in" ,
256 version =>"1.1",
257 xmlns =>"http://www.w3.org/2000/svg"
259 );
262 $out = $xml->XMLout(\%juzz , RootName=>'svg');
265 my $fixed = <<HERE;
266 <?xml version="1.0" standalone="no"?>
267 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
268 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
269 HERE
273 $fixed .= $out;
275 #print $fixed;
276 return $fixed;
278 }
282 sub mail
283 {
287 %mail =
288 (
289 from => 'rlm@mit.edu',
290 to => $_[1],
291 subject => 'Test attachment',
292 );
295 $boundary = "====" . time() . "====";
296 $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
298 $message = encode_qp( "email from your friend PERL." );
300 $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
302 $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
308 $boundary = '--'.$boundary;
309 $mail{body} = <<END_OF_BODY;
310 $boundary
311 Content-Type: text/plain; charset="iso-8859-1"
312 Content-Transfer-Encoding: quoted-printable
314 $message
315 $boundary
316 Content-Type: application/octet-stream; name="test.svg"
317 Content-Transfer-Encoding: base64
318 Content-Disposition: attachment; filename="test.svg"
320 $attach1
322 $boundary
323 Content-Type: application/octet-stream; name="huh.txt"
324 Content-Transfer-Encoding: base64
325 Content-Disposition: attachment; filename="huh.txt"
327 $attach2
328 $boundary--
330 END_OF_BODY
332 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";
335 }