Mercurial > laserkard
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/perl4 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' => \&echo35 );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 gen48 {54 $a = Laserkard::genEcho();59 return $a62 }66 sub echo67 {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 impose117 {119 #here $svg is a string which contains the properly formatted svg data for one card120 #out purpose here is to take that one card, size it correctly, and make appropiate copies121 #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 file141 #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 cards159 {161 #calcuate the thing's place in the grid:163 $cardsToARow = 5;164 $cardsToAColumn = 5;166 my $row = int($name/$cardsToARow); # cards to a row167 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.49245 by Ronan Oger246 Info: http://www.roitsystems.com/247 -->248 HERE250 $output =~ s/$killCopyrigt/\n/;252 return $output;256 }259 sub repair_file260 {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 file276 $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 HERE306 $fixed .= $out;308 #print $fixed;309 return $fixed;311 }315 sub mail316 {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 $boundary344 Content-Type: text/plain; charset="iso-8859-1"345 Content-Transfer-Encoding: quoted-printable347 $message348 $boundary349 Content-Type: application/octet-stream; name="test.svg"350 Content-Transfer-Encoding: base64351 Content-Disposition: attachment; filename="test.svg"353 $attach1356 $boundary--358 END_OF_BODY360 sendmail(%mail) || print "Error: $Mail::Sendmail::error\n";363 }