Mercurial > laserkard

annotate echo.pl @ 81:6adb5da55d18 laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
getting color select working
author Robert McIntyre <rlm@mit.edu>
date Sun, 25 Jul 2010 05:45:56 -0400
parents 375225442677
children
rev   line source
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