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} = <