CodeKeep Perl Feed

header

Sat, 11 Aug 2007 18:52:35 GMT

Description: Call perl executable with -options XML-ish documentation template

Link: http://www.codekeep.net/snippets/006e57e4-efa5-4f51-b379-c38e48ef11b2.aspx

#!perl\bin -w
# <filename></filename>
# <date></date>
# <author>A. Mick Smith</author>
# <depends></depends>
# <describe></describe>

Perl Email

Mon, 16 Oct 2006 01:38:58 GMT

Description: sending email with perl

Link: http://www.codekeep.net/snippets/00c0ece5-ba98-439f-b928-ea2d4c13a39e.aspx

use Net::SMTP;
#print rand();

sub RandomLetter{
	$letter = $_[0];
}

sub left{
	return substr($_[0], 0, $_[1]);
}

sub right{
	$mystring = reverse $_[0];
	$mystring = substr($mystring, 0, $_[1]);
	$mystring = reverse $mystring;
	return $mystring;
}

sub GetLetter{
	$mystring = $_[0];
	$mystring = left($mystring,$_[1]);
	$mystring = right($mystring,1);
	return $mystring;
}

#print GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1);
$counter = 0;
	while ($counter <=4999 ){
		$counter++;
		print "$counter\n";
		sendemail();
	}

sub sendemail{
my $ServerName = "smtp-server.cinci.rr.com";
$smtp = Net::SMTP->new($ServerName);

my $MailFrom = GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . "\@" . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . ".cc";
my $MailTo = "email\@email.com";

$smtp->mail( $MailFrom );
$smtp->to( $MailTo );
# Start the mail
$smtp->data(); 
$smtp->datasend("To:  " . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . "\@" . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . ".cc\n"); 
$smtp->datasend("From:  " . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . "\@" . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . ".cc\n");  
$smtp->datasend("Subject: " . GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . "\n");  

$smtp->datasend("\n"); 

$smtp->datasend(GetLetter("qwertyuiopasdfghjklzxcvbnm",rand()*26+1) . "\n\n"); 
$smtp->dataend(); 
$smtp->quit();
}

email html page

Sat, 04 Mar 2006 23:09:05 GMT

Description: download HTML-page, including all images, and send it by e-mail

Link: http://www.codekeep.net/snippets/82c18bd4-7e2d-4e8a-bbfc-f534f42230e7.aspx

require LWP::UserAgent;
$ua = LWP::UserAgent->new;

$ua->proxy(['http', 'ftp'], 'proxy-server address');
$req = new HTTP::Request('GET' => 'page to be downloaded');

if ($res->is_success) { $page = $res->content; }
How do I send a e-mail with an attachment?
require MIME::Lite;
$msg = MIME::Lite->new(
   From =>'your@address.com',
   To =>'recipient@address.com',
   Subject =>'Subject',
   Type => 'multipart/related');

$msg->attach(
   Type =>'text/plain; charset=windows-1251',
   Data => message text);

$msg->attach(
   Type => 'image/gif', 
   Path => path to the file, 
   Filename =>'img.gif');
$msg->send();

Model View Control (MVC) with forms, pages... and perl is simple with this lib.

Tue, 31 Jan 2006 17:34:27 GMT

Description: MVC - Load any seperate html form - Include Require Module - Using this all the forms can be kept in plain html format so they can be opened in your vavorite html editor and changed. Creates a seperation of Model View Control (MVC)

Link: http://www.codekeep.net/snippets/6fbd2fa2-2c8f-4bc8-8a60-587bb57aa680.aspx

sub build_form {
	#print "$path/$form_file_name";
open(HF, "$fpath/$process_form") || "can not open" ;
while (<HF>){	
eval <<END_OF_EVAL;
print <<END_OF_PRINT;
$_
END_OF_PRINT
END_OF_EVAL

}
}
1;

Recursive DropDown Menu

Tue, 24 Jan 2006 19:11:58 GMT

Description: Parent to child node recursive dropdown menu. Uses flat file or database. Currently used on: http://applicationlayer.com

Link: http://www.codekeep.net/snippets/becdceb2-6b32-4497-9c8b-10f66d3e3b07.aspx

###!/usr/bin/perl -w 

use CGI qw(:standard);
use Cwd;
use CGI::Cookie;
# Win32::ODBC called below when using db
# ------------------------------------------

	$dsn = "MENUS";
	$table_name = "MENU1";

# ------------------------------------------
# Get Path info - make things your cousin 
$script_name = "menu.pl";
$pa_a = cwd();
$pa_b = $ENV{'PATH_INFO'};
$pa_c = "$pa_a"."$pa_b";
$pa_c =~ /(.+)($script_name)/;
$path = $1;
$pa_b =~ /(.+)($script_name)/;
$web_path = $1;
$web_imgpath = "$web_path"."images";

#Image Directory
$imagedir = "$web_imgpath";

#Start ID
$a="0";

$menutype = "db"; # db or flatfile

# ------------ flatfile Info --------
$flatfile = "menucfg.dat"; 
$datafilepath = "$path";



# ---------------  db Info ----------
if ($menutype eq "db"){
	use Win32::ODBC;
	if (param("tm")){
		$table_name = param("tm");
	}else{
		$table_name = $table_name;
	}
}


# ---------------------------------
# script path
my $spath = "";

# HTML Properties -----------------
$bgcolor = "bgcolor = \"#ffffff\"";
$text = "red";
$bgproperties = "fixed";
$vlink = "#336633";
$alink = "#aaaaaa";
$link = "#3366cc";
$fsize = "size = \"-2\"";
$fsize_level0 = "size = \"-1\"";
$fsize_level1 = "size = \"-2\"";
# ---------------------------------
# Flush StdOut
$| = 1;

# Parse arguments


my $vl = param("vl");
my $ipr = param("ipr");
my $sc = param("sc");
my $sd = param("sd");
my $ec = param("ec");
my $ed = param("ed");

my $edit = param("edit");
my $new = param("new");
my $rollup = param("rollup");
my $rolldown = param("rolldown");
my $shcl = param("shcl");
my $shid = param("shid");
my $expandall = param("expand");






# cookie name
$cookie_name = $table_name;
# get cookies 
%pref = cookie('pref');

# Add new cookie 
if ($rolldown ne "" && $pref{$cookie_name} eq ""){
	$pref{$cookie_name} = "$rolldown";
}elsif ($rolldown ne ""){
	$pref{$cookie_name} = "$pref{$cookie_name},$rolldown";
	}
# clear cookies
#$pref{$cookie_name} = "";

#load jar with cookies
@jar = split /,/,$pref{$cookie_name};

foreach $cookie_jar (@jar){
	# Remove unwanted cookie
	if ($rollup eq $cookie_jar){
		$c_jar{$cookie_jar} = "";
	}else{
		$c_jar{$cookie_jar} = $cookie_jar;
		push(@new_c,$cookie_jar);
	}	
}
if ($rollup ne ""){
	%pref=();
	foreach $new_c (@new_c){
		if ($pref{$cookie_name} eq ""){
			$pref{$cookie_name} = "$new_c";
		}elsif ($pref{$cookie_name} ne ""){
			$pref{$cookie_name} = "$pref{$cookie_name},$new_c";
			}
	}
}
# put cookies
$the_cookie = cookie(-name=>'pref',
		-value=>\%pref,
		-expires=>'+30d');
print header(-cookie=>$the_cookie);    

# full of Cookies :)

#Security
$dbcl = 10;
#use Win32::AdminMisc; 
#require "secu.pl";
#&secu;

&html_header;
&getData2;
&checkit;
&html_footer;


sub getData
{

# ----------------- flat file ---------------------
	open(MENUCFG,"$datafilepath"."menucfg.dat");
	while(<MENUCFG>){
		if($_ =~ /^#/){
			#comment line
			#print "$_<br>";
		}else{
			# debug -- print "$_<br>";
     	   ($jname, $job_id, $parent_id, $url, $popup, $target) = split(/,/,$_);
		}
	&extractData;
	}
	close(MENUCFG);
}
sub getData2
{

# ----------------- db ---------------------
   $dsn = "MENUS";
   $sql = "SELECT * FROM MENU1;"; 
   #$sql = "SELECT * FROM MENU order by MENU_NAME;"; 
   
   
   $db = new Win32::ODBC($dsn);
   $db->Sql($sql);
   
   while ($db->FetchRow()) {
      $count = $count + 1; 
      if ($count == 1) {
         #&printDataHeader;
      }
        ($jname, $job_id, $parent_id, $url, $popup, $target, $cl) = $db->Data("MENU_NAME","MENU_ID","MENU_PARENT","URL","POPUP","TARGET","CL");
		

		&extractData;
	}
($ErrNum, $ErrText, $ErrConn) = $db->Error(); 
# print "$ErrNum, $ErrText, $ErrConn";
   $db->Close();
}
# -------------------------------------------------
sub extractData { 

	if ($target eq ""){ 
		$target = "_top";
	}else{
		$target{$jo