rlm@37: #!/usr/bin/perl
rlm@37:
rlm@37:
rlm@37: use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@37: use Storable;
rlm@37: use CGI::Ajax;
rlm@37: use CGI qw(:standard);
rlm@37: use URI::Escape;
rlm@37: use MIME::QuotedPrint;
rlm@37: use MIME::Base64;
rlm@37: use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
rlm@37: use XML::Simple;
rlm@37: use Data::Dumper;
rlm@37: $Data::Dumper::Indent = 1;
rlm@38: use Storable;
rlm@40: use SVG;
rlm@51: use Laserkard;
rlm@51:
rlm@37:
rlm@37: my $q = new CGI;
rlm@37:
rlm@37:
rlm@37:
rlm@37: my %hash =
rlm@37: (
rlm@51: 'material' => \&Laserkard::material,
rlm@51: 'template' => \&Laserkard::template,
rlm@51: 'inputbox' => \&Laserkard::inputbox,
rlm@51: 'display' => \&Laserkard::display,
rlm@51: 'change_rules' => \&Laserkard::change_rules,
rlm@51: 'vanish' => \&Laserkard::vanish,
rlm@51: 'updateForm' => \&Laserkard::updateForm,
rlm@51: 'cardType' => \&Laserkard::cardType,
rlm@37: 'echo' => \&echo
rlm@37: );
rlm@37:
rlm@37:
rlm@37:
rlm@37: my $pjx = CGI::Ajax->new(%hash);
rlm@37:
rlm@37: # this outputs the html for the page, and stops caching, so the fucker will work in IE.
rlm@37: print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
rlm@37:
rlm@37:
rlm@37:
rlm@37:
rlm@37: sub gen
rlm@37: {
rlm@37:
rlm@37:
rlm@37:
rlm@37:
rlm@51:
rlm@51: $a = Laserkard::genEcho();
rlm@51:
rlm@37:
rlm@37:
rlm@37:
rlm@37: return $a
rlm@37:
rlm@37:
rlm@37: }
rlm@37:
rlm@37:
rlm@37:
rlm@37: sub echo
rlm@37: {
rlm@37:
rlm@37:
rlm@37:
rlm@51: my $svg = shift;
rlm@37:
rlm@37:
rlm@37:
rlm@51: #my $destination = 'rlm@mit.edu';
rlm@37:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51: my @cards = split (/S3ntinEL/, $svg);
rlm@51: my $emmmm = shift;
rlm@51: #return $emmmm;
rlm@51:
rlm@51: $cardsPerMail = 30;
rlm@51: ##### ok, now we have this awesome array with all the cards we need to print.
rlm@51: # the numbers are right, so now we really just have to impose them.
rlm@51: for $mails(0..int(($#cards) / $cardsPerMail))
rlm@51: {
rlm@51:
rlm@51:
rlm@51: my $start = $mails * $cardsPerMail;
rlm@51:
rlm@51: my $end = ($#cards >($start + $cardsPerMail)) ? ($start + $cardsPerMail) : $#cards;
rlm@51:
rlm@51: $svg = &impose(@cards[$start..$end]);
rlm@51: #$svg = &impose($cards[$end]);
rlm@51:
rlm@51: &mail($svg, $emmmm);
rlm@51: }
rlm@51:
rlm@51:
rlm@52: #return "Success";
rlm@52: return "
Success!
".(int(($#cards) / $cardsPerMail)+1). " email(s)
Succesuffuly sent to : $emmmm
".($#cards+1). " cards were included in the SVG file(s).";
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@37:
rlm@37: }
rlm@37:
rlm@37:
rlm@40:
rlm@40: sub impose
rlm@40: {
rlm@40:
rlm@40: #here $svg is a string which contains the properly formatted svg data for one card
rlm@40: #out purpose here is to take that one card, size it correctly, and make appropiate copies
rlm@40: #so that our supplier can simply import the file and print.
rlm@40:
rlm@51: my $xml = new XML::Simple;
rlm@51: my @cards = @_;
rlm@51:
rlm@51:
rlm@51: for (0..$#cards)
rlm@51: {
rlm@51:
rlm@51: $cards[$_] =~ s/^/\n\n\n/;
rlm@51: $cards[$_] =~ s/$/\n\n\n/;
rlm@40: # you fucking bitch!
rlm@51: $cards[$_] =~ s/Created wit........//;
rlm@51: }
rlm@40:
rlm@40: # read XML file
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51: #print Dumper(%juzz);
rlm@51:
rlm@51:
rlm@51: my $svg= SVG->new(width=>"18in",height=>"14in");
rlm@51:
rlm@51: #print Dumper($juzz{'path'}[2]);
rlm@51: #print "\n***************************\n";
rlm@51: #print Dumper($pathData);
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51: my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
rlm@51:
rlm@51:
rlm@51: my @cardCollection;
rlm@51:
rlm@51: for $name(0..$#cards) #22 letters for 22 cards
rlm@51: {
rlm@51:
rlm@51: #calcuate the thing's place in the grid:
rlm@51:
rlm@51: $cardsToARow = 5;
rlm@51: $cardsToAColumn = 5;
rlm@51:
rlm@51: my $row = int($name/$cardsToARow); # cards to a row
rlm@51: my $column = int($name % $cardsToAColumn);
rlm@51:
rlm@51: $margin = 25;
rlm@51: $cardWidth = 514*0.6057;
rlm@51: $cardHeight = 317*0.6057;
rlm@51:
rlm@51:
rlm@51: $transX = 40 + ($margin + $cardWidth ) * $column;
rlm@51: $transY = 40 + ($margin + $cardHeight) * $row;
rlm@51:
rlm@51:
rlm@51:
rlm@51: ${"group_".$name} =
rlm@51: $svg->group(
rlm@51: id => "group_".$name,
rlm@51: transform => "translate($transX,$transY),"."$base"
rlm@51: );
rlm@51:
rlm@51: push @cardCollection, ${"group_".$name};
rlm@51: }
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51:
rlm@51: for ($i = 0; $i <= $#cardCollection; $i++)
rlm@51: {
rlm@51:
rlm@51:
rlm@51: my $data = $xml->XMLin($cards[$i], ForceArray => 1);
rlm@40:
rlm@40:
rlm@40: my %data = %$data;
rlm@40:
rlm@40: my %juzz =
rlm@40: (
rlm@40:
rlm@40: path => $data{'path'},
rlm@40: rect => $data{'rect'},
rlm@40: width =>"16in" ,
rlm@40: height =>"12in" ,
rlm@40: version =>"1.1",
rlm@40: xmlns =>"http://www.w3.org/2000/svg"
rlm@40:
rlm@40: );
rlm@40:
rlm@40:
rlm@40: for $pathData(@{$juzz{'path'}})
rlm@40: {
rlm@40: $cardCollection[$i]->tag('path', %{$pathData});
rlm@40: }
rlm@40:
rlm@40: for $pathData(@{$juzz{'rect'}})
rlm@40: {
rlm@40: $cardCollection[$i]->tag('rect', %{$pathData});
rlm@40: }
rlm@40:
rlm@40:
rlm@40: }
rlm@40:
rlm@40:
rlm@40:
rlm@40: #my $tag = $svg->tag('path', $juzz{'path'});
rlm@40:
rlm@40:
rlm@40: #$tag = $svg->group(%attributes);
rlm@40:
rlm@40:
rlm@40: $output = $svg->xmlify;
rlm@40:
rlm@40:
rlm@40: $killCopyrigt = <
rlm@40: HERE
rlm@40:
rlm@40: $output =~ s/$killCopyrigt/\n/;
rlm@40:
rlm@40: return $output;
rlm@40:
rlm@40:
rlm@40:
rlm@40: }
rlm@40:
rlm@40:
rlm@37: sub repair_file
rlm@37: {
rlm@37:
rlm@37:
rlm@38: $sss = $_[0];
rlm@37:
rlm@37:
rlm@37:
rlm@38: $sss =~ s/^/\n\n\n/;
rlm@38: $sss =~ s/$/\n\n\n/;
rlm@38: # you fucking bitch.
rlm@38: $sss =~ s/Created wit........//;
rlm@37:
rlm@37:
rlm@38: store \$sss, 'file';
rlm@37:
rlm@37: # read XML file
rlm@38: $xml = new XML::Simple;
rlm@37: $data = $xml->XMLin($sss, ForceArray => 1);
rlm@37:
rlm@37:
rlm@37: my %data = %$data;
rlm@37:
rlm@37: my %juzz =
rlm@37: (
rlm@37:
rlm@37: path => $data{'path'},
rlm@37: rect => $data{'rect'},
rlm@37: width =>"16in" ,
rlm@37: height =>"12in" ,
rlm@37: version =>"1.1",
rlm@37: xmlns =>"http://www.w3.org/2000/svg"
rlm@37:
rlm@37: );
rlm@37:
rlm@37:
rlm@37: $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@37:
rlm@37:
rlm@37: my $fixed = <
rlm@37:
rlm@37: HERE
rlm@37:
rlm@37:
rlm@37:
rlm@37: $fixed .= $out;
rlm@37:
rlm@37: #print $fixed;
rlm@38: return $fixed;
rlm@37:
rlm@37: }
rlm@37:
rlm@37:
rlm@37:
rlm@37: sub mail
rlm@37: {
rlm@37:
rlm@37:
rlm@37:
rlm@37: %mail =
rlm@37: (
rlm@37: from => 'rlm@mit.edu',
rlm@37: to => $_[1],
rlm@37: subject => 'Test attachment',
rlm@37: );
rlm@37:
rlm@37:
rlm@37: $boundary = "====" . time() . "====";
rlm@37: $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
rlm@37:
rlm@37: $message = encode_qp( "email from your friend PERL." );
rlm@37:
rlm@37: $attach1 = encode_base64($_[0]); # this part is so cool! I can e-mail a perl varible to anyone in the world!
rlm@37:
rlm@37: $attach2 = encode_base64("hi this is a test arttacghjkalsdlasndlashdlsf");
rlm@37:
rlm@37:
rlm@37:
rlm@37:
rlm@37:
rlm@37: $boundary = '--'.$boundary;
rlm@37: $mail{body} = <