March 11, 2005
shawn's code
#!/usr/bin/perl -w
#use strict;
use MIME::Parser;
use MIME::Entity;
use MIME::Base64;
use Net::POP3;
#use Net::POP3_ssl;
use XMLRPC::Lite;
my $username = 'myusername'; ## CHANGE THIS LINE
my $password = 'mypassword'; ## CHANGE THIS LINE
my $pop = Net::POP3->new('mymailserver', Timeout => 15); ## CHANGE THIS LINE
my $max_chars = 70; # Number of chars to allow in a line of text from an incoming message ## CHANGE THIS LINE
my $temp_folder = "/path/to/my/tmp/folder/"; ## CHANGE THIS LINE
my $image_output_folder = "/path/to/where/the/images/or/video/should/be/saved/"; ## CHANGE THIS LINE
my $image_output_folder_relative = "http://servername/relative/path/to/images/or/video/"; ## CHANGE THIS LINE
my $delete_messages = 1;
my $delete_temp_files = 1;
my $print_output = 1;
my $post_to_blog = 1;
my $blog_xmlrpc_url = "http://myserver/path/to/mt/mt-xmlrpc.cgi"; ## CHANGE THIS LINE
my $blog_id = 2; ## CHANGE THIS LINE
my $blog_username = "blogusername"; ## CHANGE THIS LINE
my $blog_password = "blogpassword"; ## CHANGE THIS LINE
my $umask = '0002'; # File creation to 775, 0022 would be 755
$umask = oct($umask) if $umask =~ /^0/;
if ($pop->login($username, $password))
{
umask $umask;
print(localtime() . "\n");
my $parser = MIME::Parser->new;
$parser->output_dir($temp_folder);
my $msgnums = $pop->list; # hashref of msgnum => size
my $messagenum = 0;
foreach my $msgnum (keys %$msgnums)
{
my $msg = $pop->get($msgnum);
###
# TO GET RAW DATA
###
#foreach my $messageline (@$msg)
#{
# chomp($messageline);
# print $messageline;
#}
my $entity = $parser->parse_data($msg);
#my $entity = $parser->parse(\*STDIN); // For testing with message file -- perl myphoto.pl < message
###
# GET MESSAGE HEADER
###
my $msg_head = $entity->head;
my $subject = "";
my $to = "";
my $from = "";
my $body = "";
my $attachment = "";
my $attachment_type = "";
my $attachment_relative = "";
##
# GET MESSAGE SUBJECT
##
if ($msg_head->count('Subject') > 0)
{
$subject = $msg_head->get('Subject');
}
##
# GET MESSAGE FROM
##
if ($msg_head->count('From') > 0)
{
$from = $msg_head->get('From');
if ($from =~ /<(.*)>/)
{
$from = $1;
}
}
##
# GET MESSAGE TO
##
if ($msg_head->count('To') > 0)
{
$to = $msg_head->get('To');
if ($to =~ /<(.*)>/)
{
$to = $1;
}
}
###
# GET MESSAGE PARTS (BODY AND ATTACHMENTS)
###
my @parts=$entity->parts;
my $partnum = 0;
my $mime_message_body;
my $is_mime = 0;
while(my $part = shift(@parts))
{
$is_mime = 1; # Yes we have a mime message
my $type=$part->head->mime_type || $part->head->effective_type;
if ($type =~ /image\/jpeg/ || $type =~ /image\/jpg/)
{
# Give me the entire body as one string (probably bad because these could be BIG images)
my $image = $part->bodyhandle->as_string;
my $file_name = "picture_" . time() . $partnum . $messagenum . ".jpg"; ## Make names uinque
my $image_file = $image_output_folder . $file_name;
my $fh = new FileHandle "> $image_file";
if (defined $fh) {
print $fh $image;
$fh->close;
}
$attachment = $file_name;
$attachment_type = "jpeg";
$attachment_relative = $image_output_folder_relative . $file_name;
}
elsif ($type =~ /text\/plain/i || $type =~ /text\/html/i)
{
# Plain Text portions or attachments
my $message_bodyhandle = $part->bodyhandle;
$mime_message_body = $message_bodyhandle->as_string;
@mime_message_array = split('\n',$mime_message_body);
my $done = 0;
foreach $message_line (@mime_message_array)
{
$message_line =~ s/<.*>//gi; # Strip out any HTML tags
if ($message_line =~ /^\n/ ||
$message_line =~ /^\s*\n/ ||
$message_line !~ /\w/)
{
# Ignore blank lines
}
elsif (length $message_line > $max_chars)
{
# Ignore lines too long to be text messages
}
elsif (!$done)
{
$message_body = $message_line; # Only grabbing first line
$done = 1;
}
}
$body = $message_body;
}
elsif ($type =~ /video\/3gpp/i)
{
# Video Mail
# Give me the entire body as one string (probably bad because these could be BIG)
my $video = $part->bodyhandle->as_string;
my $file_name = "video_" . time() . $partnum . $messagenum . ".3gp"; ## Make names uinque
my $video_file = $image_output_folder . $file_name;
my $fh = new FileHandle "> $video_file";
if (defined $fh) {
print $fh $video;
$fh->close;
}
$attachment = $file_name;
$attachment_type = "3gpp";
$attachment_relative = $image_output_folder_relative . $file_name;
}
else
{
print "Other Types " . $type . "\n\n"; # OUTPUT
}
$partnum++;
}
##
# IF IT ISN'T A MIME MESSAGE (NO ATTACHMENTS)
##
if (!$is_mime)
{
###
# GET MESSAGE BODY LINES
###
$msg_body = $entity->body;
my $message_body = "";
my $done = 0;
foreach $message_line (@$msg_body)
{
if ($message_line =~ /^\n/)
{
}
elsif (!$done)
{
$message_body = $message_line;
$done = 1;
}
}
$body = $message_body;
}
chomp($to);
chomp($from);
chomp($subject);
chomp($body);
if ($post_to_blog)
{
my $attachment_html = "";
if ($attachment_type eq "jpeg")
{
$attachment_html = "";
}
elsif ($attachment_type eq "3gpp")
{
$attachment_html = "
";
}
my $postresult=XMLRPC::Lite
->proxy($blog_xmlrpc_url)
->call('metaWeblog.newPost',$blog_id,$blog_username,$blog_password,
{
'title'=>$subject,
'description'=>$body . $attachment_html,
'mt_allow_comments'=>1,
'mt_allow_pings'=>1
},
1
)
->result;
}
if ($print_output)
{
print "Message To: $to\n";
print "Message From $from\n";
print "Message Subject $subject\n";
print "Message Body $body\n";
print "Message Attachment $attachment\n";
print "--------------------------\n";
}
if ($delete_messages)
{
$pop->delete($msgnum);
}
if ($delete_temp_files)
{
$parser->filer->purge;
}
$messagenum++;
}
}
$pop->quit;
Posted by dimitri at 01:21 AM | Comments (0)
February 14, 2005
assignment 3
#!/usr/bin/perl
use CGI::Carp qw(fatalsToBrowser);
# Define the name of the script just for reference
$scriptName = "mysql.cgi";
# Tell the browser what type of data to expect
print "Content-type: text/html\n\n";
#########################################################
# Print HTML
#########################################################
print qq^
"http://www.w3.org/TR/html4/loose.dtd">
This is the structure for the database Puffles:

PrePopulation:

'at the beach' added:

Select command used to find entries older then 2004/04/11:

Results from select command:

Command update:

Delete Command:

Final Population:

^;
exit;
Posted by dimitri at 03:04 AM | Comments (0)
February 07, 2005
Assignment 2
Since I missed class, this is more my style of who I would do it, using the example code.
Code is in read more
This is the cgi:
#!/usr/bin/perl
#########################################################
# class02-file1.pl - Basic File I/O
#########################################################
# Use CGI Perl module to output any error msgs to browser
use CGI::Carp qw(fatalsToBrowser);
# Define the name of the script just for reference
$scriptName = "test.cgi";
$pageTitle = "thoughts";
# Obtain any variables submitted either in the URL string
# or by an HTML form via the GET or POST method, and
# place in the %INPUT_VARS hash array
%INPUT_VARS = {};
&input_vars_receive;
&input_vars_parse;
#########################################################
# Define which file we will be using on the server
#########################################################
$myFile = "/home/dimitri/public_html/blog/dweb/file1.txt";
#########################################################
# Define our widgets here and collect values from INPUT_VARS array
#########################################################
$textWidgetLabel = "Penny for a thought:";
$textWidgetName = "Thought";
$textWidgetValue = $INPUT_VARS{$textWidgetName};
$submitWidgetName = "dataAction";
$submitWidgetValue = "Enter";
$commentWasSubmitted = 0;
#########################################################
# Check our inputs and perform any file content updates
#########################################################
if ($INPUT_VARS{$submitWidgetName} eq "$submitWidgetValue")
{ # Form was submitted so check if the comment field actually had text
if ($textWidgetValue ne "")
{ # This is how you write text to a file in Perl
open INPTR, ">>$myFile";
print INPTR "
";
print INPTR "$textWidgetValue\n";
print INPTR "
close INPTR;
# Set a flag so that we know that we actually had a valid comment
$commentWasSubmitted = 1;
}
}
# Tell the browser what type of data to expect
print "Content-type: text/html\n\n";
#########################################################
# Print our initial HTML
#########################################################
print qq^
^;
print qq^
^;
# Give the user feedback if they submitted something
if ($commentWasSubmitted==1)
{ print qq^
Its good to think! |
read the thoughts |
^;
}
print qq^