scratchpad

wjw's scratchpad (wjw)

Will have to put something here.. perhaps when I have an itch...

adrianxw's scratchpad (adrianxw)

Scratchpad - no content

nishanth_ev's scratchpad (nishanth_ev)

my $deployed_sql = <<__SQL__;
SELECT

n7.NODE_PATH_NAME,

n2.NODE_PATH_NAME,

ROUND( ( ( sum(sw.SOFTWARE_FILE_SIZE) / 1024 ) /1024), 1),

sw.SOFTWARE_DISPLAY_NAME

FROM

NODES n1,

NODES n2,

NODES n3,

NODES n4,

NODES n5,

NODES n6,

NODES n7,

NODES n8,

SOFTWARE sw,

NODE_SOFTWARE ns

AND n1.NODE_ID = n2.PARENT_NODE_ID

AND n2.NODE_ID = n3.PARENT_NODE_ID

AND n3.NODE_ID = n4.PARENT_NODE_ID

AND n4.NODE_ID = n5.PARENT_NODE_ID

AND n5.NODE_ID = n6.PARENT_NODE_ID

AND n6.NODE_ID = n7.PARENT_NODE_ID

AND n7.NODE_ID = n8.PARENT_NODE_ID

AND n8.NODE_ID = ns.NODE_ID

AND sw.SOFTWARE_ID = ns.SOFTWARE_ID

AND n3.NODE_SHORT_NAME = ?

GROUP BY
n7.NODE_PATH_NAME,n2.NODE_PATH_NAME,n3.NODE_ID,sw.SOFTWARE_DISPLAY_NAME__SQL__

my $dbh =DBI->connect( $opswdb{dsn}, $opswdb{user},

$opswdb{pass},{ AutoCommit => 1, ChopBlanks => 1 } );

my $sth = $dbh->prepare($deployed_sql);

$sth->execute($appname);

jimt's scratchpad (jimt)

For Limbic~Region:

My version may scale better than yours does, if you needed it to operate on larger sets or greater numbers of sets. I think more larger sets is where mine shines more.

Try this out, it generates a random data file:

#!/usr/bin/perlmy @letters = ('a'..'z');foreach (1..5000) {my $length = int(rand 26);my %pool = map {$_ => 1} @letters;for (0..$length) {my $v = (keys %pool)[int rand(scalar keys %pool)];delete $pool{$v};print $v;}print "\n";}

Now, admittedly, who knows how the CPU was partitioning up time for the jobs or whatnot. But, I kicked your version off and let it sit for about 2 minutes, then I kicked mine off after that. Your version had a 2 million line lead at that point.

As it chugged along, the gaps narrowed, until mine eventually ended up 2.3 million lines ahead before I killed 'em off.

It was also using about 1/3rd the ram - about 100 megs vs 350 for yours, roughly.

sabari's scratchpad (sabari)

Scratchpad - no content

journey's scratchpad (journey)

Scratchpad - no content

andreas1234567's scratchpad (andreas1234567)

Scratchpad - no content

Bucchi's scratchpad (Bucchi)

Scratchpad - no content

Chalai's scratchpad (Chalai)

#This is a section of part three.  The sorted doc groups are chopped down to individual docs and saved.open (APPFORWRIT, "repository\\AppForWrit.txt") or die "AppForWrit.txt not found \n";my @docgroup =  ;while ($docgroup[0]) {if ($docgroup[0] =~ /ELECTRONIC FILING ONLY/) {&finalpack;}else {shift (@docgroup);}}sub finalpack {@final = @docgroup[0..131];#Below generates the file name and dumps the contents to the file$date = $final[129];$acct = $final[130];$datecut = substr ($date, 18, 11); chomp ($datecut);$acctcut = substr ($acct, 22, 12); chomp ($acctcut);$d_a_t = "$datecut $acctcut App for Writ";print "Creating $d_a_t \n";open(my $d_a_t, '>', "$d_a_t\.txt") or die("Unable to create file \"$d_a_t\": $!\n");print $d_a_t @final;close ($d_a_t);#This should cut the text just printedsplice (@docgroup, 0, 130);}close (APPFORWRIT);

SFLEX's scratchpad (SFLEX)

SF_form_secure - example of securing form field data

# making the data# require modulerequire SF_form_secure;# set variables$SF_form_secure::code = 'The_Key';$SF_form_secure::exp = '';$SF_form_secure::ip_ct = '';# make secure code I am using  Married but all below value can be used one at a timemy $secure_value = SF_form_secure::x_secure(4, 'Married', '');# add the controled value with secure code!$secure_value = 'Married' . '|' . $secure_value;# The part of the form to secure is Married# # ------------------------------------------------------------------------# Checking The data# require modulerequire SF_form_secure;# set variables$SF_form_secure::code = 'The_Key'; # same key as above$SF_form_secure::exp = ''; # same key as above$SF_form_secure::ip_ct = ''; # same key as above# cut the codes to check or set the input $marstat to noneif ($marstat && $marstat =~ s/^(.*?)\|(.*?)$/$1/) {my $data_controle = $2 || '';# Check the datamy $secure_value = SF_form_secure::x_secure(5, $marstat, $data_controle);# your doing good if its 1 and for english errors you could use $secure_value# for 4.0 you have to use ne 1 becase with a blank $data_controle variable will return the package version. if ($secure_value ne 1) {      user_error('Problem with form content');      }}else {$marstat = '';}

iridius's scratchpad (iridius)

#! /usr/bin/perl --# the purpose of this script is take the user input in the form of text# and count each unique word# the code SHOULD count occurences of the word# then print each word in a table row, with the second cell  having the number of occurences of each worduse strict;use CGI qw(:standard);if (param()) {my @params = param();my $fname = param('fname');if(!$fname){dienice("You did not enter your name, please click the back button\n");}my $email = param('email');if(!$email){dienice("You did not enter your email, please click the back button\n");}my $text2count = param('text2count');if(!$text2count){dienice("You did not enter any text to analyze, please click the back button\n");}my $textcolor= param('textcolor');my $bgcolor= param('bgcolor');print header();print ("");print start_html("Welcome to text analaysis");my $text2count = param('text2count');# get a text array from textmy @textarray = get_text_array($text2count);# make a hash out of this array @textarraymy %texthash = get_counting_hash(@textarray);# after get all of the values needed, print out the content for the result:print ("");while (($key, $value) = each %texthash) {print ("");}print ("$value $key
");} else {print header();print ("");print start_html("Welcome to text analaysis");print ("We're going to analyze some text you enter!

");print ("        Please enter your first name:                       
      Please enter your email:                       
                      
      Please enter some text:                       
                      
      Choose a text color:                       
      Choose a background color:                       
                      
          


  
  
  

");}print end_html();# subroutine to die - provided by our teachersub dienice {my ($s) = @_;print $s, "\n";exit(1);}# make a text array out of the plain textsub get_text_array {return split(/ /, $_[0]);}# building a hash counting words from an array of words# the keys are the words# the values are the number of occurrences of that word in the arraysub get_counting_hash {my @wordArray = @_;my %wordHash = ();# I think I need some more code here?return %wordHash;}

Here is the error code I am getting:malformed header from script. Bad header=Global symbol "$key" requires : cgiwrap

bones's scratchpad (bones)

Scratchpad - no content

lyklev's scratchpad (lyklev)

#!/usr/bin/perluse strict;use warnings;use Tk;use Tk::Canvas;my $self = { };# configurationmy $n_circles = 500;my $c_width  = 600;my $c_height = 400;my $r = 3;# initialise datamy @circles;for (1..$n_circles) {   my $x = rand;   my $y = rand;   push (@circles, [$x, $y]);}$self -> {'circles'} = \@circles;# initial zoom$self -> {'max_x'} = 1.0;$self -> {'min_x'} = 0.0;$self -> {'max_y'} = 1.0;$self -> {'min_y'} = 0.0;$self -> {'can_w'} = $c_width;$self -> {'can_h'} = $c_height;$self -> {'mode'}  = '';&compute_transform($self);# draw the main window and the canvasmy $mw = Tk::MainWindow -> new();my $can = $mw -> Canvas(-width  => $c_width,                        -height => $c_height,                       );my $butcan = $mw -> Canvas();$self -> {'button_zoom'} =     $butcan -> Button (-text    => 'Zoom',                       -command => [\&zoom, $self]);$self -> {'button_zoomall'} =    $butcan -> Button (-text => 'Zoom all',                       -command => [\&zoomall, $self] );$self -> {'button_zoom'} -> pack(-side => 'left');$self -> {'button_zoomall'} -> pack(-after => $self -> {'button_zoom'},                                    -side  => 'left');$butcan -> pack (-side => 'top',                 -fill => 'x');$can -> pack(-side    => 'bottom',             -expand  => 1,             -fill    => 'both');$self -> {'can'} = $can;$can -> Tk::bind ('<1>' => [\&mouse1, Ev('x'), Ev('y'), $self]);$can -> Tk::bind ('<2>' => [\&mouse2, Ev('x'), Ev('y'), $self]);$can -> Tk::bind ('' => [\&motion, Ev('x'), Ev('y'), $self]); &draw ($self);MainLoop();sub draw {   my ($self) = @_;   foreach (@{$self -> {'circles'}}) {      my ($x_c, $y_c) = &real_to_screen ($self, @$_);      $self -> {'can'} -> createOval($x_c - 2, $y_c - 2, $x_c + 2, $y_c + 2);   }   return;}   sub real_to_screen {   my ($self, $x_r, $y_r) = @_;   my $x_s = $self -> {'can_w'} / 2.0 +             $self -> {'sca_x'} * ($x_r - $self -> {'mid_x'});   my $y_s = $self -> {'can_h'} / 2.0 -              $self -> {'sca_y'} * ($y_r - $self -> {'mid_y'});   return ($x_s, $y_s);}sub screen_to_real {   my ($self, $x_s, $y_s) = @_;   my $x_r = ($x_s - $self -> {'can_w'} / 2.0) / $self -> {'sca_x'} +              $self -> {'mid_x'};   my $y_r = ($self -> {'can_h'} / 2.0 - $y_s) / $self -> {'sca_y'} +              $self -> {'mid_y'};   return ($x_r, $y_r);}sub compute_transform {   my $self = shift;   $self -> {'sca_x'} =      $self -> {'can_w'} / ($self -> {'max_x'} - $self -> {'min_x'});   $self -> {'sca_y'} =       $self -> {'can_h'} / ($self -> {'max_y'} - $self -> {'min_y'});   $self -> {'mid_x'} = ($self -> {'max_x'} + $self -> {'min_x'}) / 2.0;   $self -> {'mid_y'} = ($self -> {'max_y'} + $self -> {'min_y'}) / 2.0;   return;}   sub zoom {   my ($self) = @_;   $self -> {'button_zoom'} -> configure(-state => 'active');   $self -> {'mode'} = 'zoom0';   return;}sub zoomall {   my $self = shift;   $self -> {'min_x'} = 0;   $self -> {'max_x'} = 1;   $self -> {'min_y'} = 0;   $self -> {'max_y'} = 1;   $self -> {'can'} -> delete('all');   &compute_transform ($self);   &draw ($self);   return;}sub mouse1 {   my (undef, $x, $y, $self) = @_;   if ($self -> {'mode'} eq 'zoom0') {      $self -> {'window'} = [$x, $y, $x, $y];      $self -> {'window_id'} =         $self -> {'can'} -> createRectangle(@{$self -> {'window'}},                                            -dash => '-');      $self -> {'mode'}  = 'zoom1';      print "Window created.\n";   }   elsif ($self -> {'mode'} eq 'zoom1') {      print "zooming to $x, $y\n";      $self -> {'can'} -> delete ($self -> {'window_id'});      ($self -> {'min_x'}, $self -> {'min_y'}) =         &screen_to_real ($self, $self -> {'window'} -> [0],                                 $self -> {'window'} -> [1]);      ($self -> {'max_x'}, $self -> {'max_y'}) =         &screen_to_real ($self, $self -> {'window'} -> [2],                                 $self -> {'window'} -> [3]);      &compute_transform($self);      $self -> {'can'} -> delete('all');      &draw ($self);      $self -> {'mode'} = '';   }   return;}sub motion {   my (undef, $x, $y, $self) = @_;   if ($self -> {'mode'} eq 'zoom1') {      $self -> {'can'} -> delete ($self -> {'window_id'});      $self -> {'window'} -> [2] = $x;      $self -> {'window'} -> [3] = $y;      $self -> {'window_id'} =          $self -> {'can'} -> createRectangle(@{$self -> {'window'}},                                            -dash => '-');   }   return;}

quester's scratchpad (quester)

print "empty scratchpad";

smammy's scratchpad (smammy)

Scratchpad - no content

brig's scratchpad (brig)

Scratchpad - no content

markh's scratchpad (markh)

Scratchpad - no content

rquinlan's scratchpad (rquinlan)

Scratchpad - no content

lowphive's scratchpad (lowphive)

Scratchpad - no content

caelifer's scratchpad (caelifer)

Scratchpad - no content

jtsceioa's scratchpad (jtsceioa)

Scratchpad - no content

sideval's scratchpad (sideval)

Scratchpad - no content

Resin's scratchpad (Resin)

Monks are cool. I visited Belgium and they had these monks that made great, super alcoholic beer. They are called Trappists.

mbruce's scratchpad (mbruce)

Scratchpad - no content

jonsmith1982's scratchpad (jonsmith1982)

md5 password cracker

#!/usr/bin/perl -wuse strict;use Digest::Perl::MD5 'md5_hex';my $list = "mil-dic.txt";my @hash = ("13ef708e32874151851382bf1e05c429");my $number = 1;open (F, $list) || die ("\nCan not open file : ".$!."\n\n");while() {   my $word = $_;   check($word);}close(F);exit(0);sub check {   my $pass = shift;   $pass =~ s/[\r\n]//g;   my $match_1 = md5_hex $pass;   foreach my $match_2 (@hash) {      if ($match_1 eq $match_2) {         print "\nFound !\t[".$match_2."] : [".$pass."] : [".$number."]\n\n";         open (A, ">>found.txt") || die ("\nCan not open file : ".$!."\n\n");         print A "[".$match_2."] : [".$pass."]\n";         close(A);      }   }   $number++;}

alvingao's scratchpad (alvingao)

Scratchpad - no content

tolyan77's scratchpad (tolyan77)

Scratchpad - no content

muthuk_v's scratchpad (muthuk_v)

Scratchpad - no content

b4swine's scratchpad (b4swine)

Scratchpad - no content

sj1's scratchpad (sj1)

Scratchpad - no content

ashokpj's scratchpad (ashokpj)

Scratchpad - no content

mandarin's scratchpad (mandarin)

Scratchpad - no content

jalex's scratchpad (jalex)

Scratchpad - no content

texasperl's scratchpad (texasperl)

Scratchpad - no content

Mike's scratchpad (Mike)

I can not view the next page. I would appreciate if some one can help me.#!/usr/bin/perl#!C:/perl/bin/perlprint "Content-type:text/html\n\n";use CGI qw(:standard);use CGI::Carp qw(fatalsToBrowser);use DBI ();if(!$start) {$start = 0;} my $eu = ($start - 0); my $limit = 5; my $this = $eu + $limit; my $back = $eu - $limit ; my $next = $eu + $limit; ### Perform the connection using the MYSQL Driver.#open connection to MYSQL.my $dbh = DBI->connect("DBI:mysql:database=aramco;host=localhost", "root","buick89")or die "Can't make connect to the database: $DBI::errstr\n";my $sql=("select * from student ");$sth = $dbh->prepare($sql);$sth->execute();my $nume = $sth->rows;print "";print "

Tower II Lease Return Project

\n";print "";print "";print "";print "";my $sql=("select * from student limit $eu, $limit");$sth = $dbh->prepare($sql) ;$sth->execute( ) ;while (@row=$sth->fetchrow_array) { if($bgcolor=='f1f1f1' ){$bgcolor='99FF99';}else{$bgcolor='f1f1f1';}print "";print "\n"; print "\n"; print "\n"; print "";}print "

Name	Class	Mark
$row1	$row2	$row3

\n";print "

";if( $nume >= 0 ) { print "PREV";} print "

";my $i=0;my $l=1;for($i=0; $i < $nume; $i=$i+$limit ){if($i!=$eu){print "$l ";} else { print " $l";} $l=$l+1;}print "

";if($this < $nume) { print "NEXT";} print "

";print "
\n";print "

\n";print "\n";print "";print "";print "";$dbh->disconnect or warn "Disconnect failed: $DBI::errstr\n";exit;

jwu's scratchpad (jwu)

Scratchpad - no content

jay's scratchpad (jay)

Scratchpad - no content

sunnavy's scratchpad (sunnavy)

Scratchpad - no content

DrWhynot's scratchpad (DrWhynot)

Scratchpad - no content

fenLisesi's scratchpad (fenLisesi)

Scratchpad - no content

holandes777's scratchpad (holandes777)

Scratchpad - no content

panguar's scratchpad (panguar)

Scratchpad - no content

hgolden's scratchpad (hgolden)

Scratchpad - no content

AgedOne's scratchpad (AgedOne)

Scratchpad - no content

babug_prg's scratchpad (babug_prg)

Scratchpad - no content

eriam's scratchpad (eriam)

Scratchpad - no content

josephworkman's scratchpad (josephworkman)

Scratchpad - no content

rkaminski's scratchpad (rkaminski)

Scratchpad - no content

Jin's scratchpad (Jin)

Scratchpad - no content

Danaita's scratchpad (Danaita)

Scratchpad - no content

Jeremy's scratchpad (Jeremy)

Scratchpad - no content

Lynx Iberu's scratchpad (Lynx Iberu)

Scratchpad - no content

perlmonkey2's scratchpad (perlmonkey2)

Scratchpad - no content

gar0t0's scratchpad (gar0t0)

Scratchpad - no content

lin0's scratchpad (lin0)

Fuzzy C-means

#!/usr/bin/perluse warnings;use strict;# fcm: fuzzy c-means implementation in Perl# usage: $fcm [number_of_clusters] [fuzzyfication_factor]#        [max_iter] [tolerace]# returns: prototypes, partition matrix# ## reading data#my ( @data, @tmp, $rows, $columns );while (defined(my $line = )) {  chomp ($line);  @tmp = split /\s+/, $line;  push @data, [ @tmp ];}$columns = @tmp;$rows    = @data;## assigning other variables#my $number_of_clusters   = shift @ARGV;my $fuzzification_factor = shift @ARGV;my $max_iter             = shift @ARGV;my $tolerance            = shift @ARGV;unless (defined($number_of_clusters)) {  $number_of_clusters = 2;}unless (defined($fuzzification_factor)) {  $fuzzification_factor = 2.0;}unless (defined($max_iter)) { $max_iter = 4000; }unless (defined($tolerance)) { $tolerance = 0.00001; }## initializing partition matrices#my @previous_partition_matrix;my @current_partition_matrix =      initialize_partition_matrix($number_of_clusters, $rows);          ## fuzzy c means implementation#my ($iter, @dist, $sum_numerator, $sum_denominator, @prototypes);$iter = 0;while ( 1 ){  # computing each prototype  for (my $i = 0; $i < $number_of_clusters; $i++) {    for (my $k = 0; $k < $columns; $k++) {      $sum_numerator = 0;      $sum_denominator = 0;      for (my $j = 0; $j < $rows; $j++) {        $sum_numerator +=           $data[$j][$k] * ($current_partition_matrix[$i][$j] **            $fuzzification_factor);        $sum_denominator +=          $current_partition_matrix[$i][$j] ** $fuzzification_factor;      }      $prototypes[$i][$k] = $sum_numerator / $sum_denominator;    }  }  # copying partition matrix  for (my $i = 0; $i < $number_of_clusters; $i++) {    for (my $j = 0; $j < $rows; $j++) {      $previous_partition_matrix[$i][$j] =         $current_partition_matrix[$i][$j];    }  }  # updating the partition matrix  my ($sum, @pattern_is_prototype);  for (my $i = 0; $i < $number_of_clusters; $i++) {    for (my $j = 0; $j < $rows; $j++) {      $dist[$i][$j] = distance( $prototypes[$i], $data[$j] );    }  }  for (my $i = 0; $i < $number_of_clusters; $i++) {    for (my $j = 0; $j < $rows; $j++) {    $sum = 0.0;    if ( $dist[$i][$j] == 0 ) {      $current_partition_matrix[$i][$j] = 1.0;    } else {        for (my $l = 0; $l < $number_of_clusters; $l++) {          $sum += ( $dist[$i][$j]/$dist[$l][$j] )               ** ( 2.0 / ($fuzzification_factor - 1.0) )                  unless ($dist[$l][$j] == 0);        }        $current_partition_matrix[$i][$j] = 1.0 / $sum           unless ($sum == 0);      }    }  }    # checking stop conditions    last if ( ++$iter == $max_iter );    my ($dif, $max_dif);    $max_dif = 0;CLUSTER:    for (my $i = 0; $i < $number_of_clusters; $i++){        for (my $j = 0; $j < $rows; $j++){            $dif = abs( $current_partition_matrix[$i][$j] -                         $previous_partition_matrix[$i][$j] );            $max_dif = $dif if ($dif > $max_dif);            last CLUSTER if ( $max_dif > $tolerance );        }    }#    print "max dif= $max_dif\n";    last if ($max_dif < $tolerance);    }## Performance Index calculation#my $performance_index;for (my $i = 0; $i < $number_of_clusters; $i++){  for (my $j = 0; $j < $rows; $j++){      my $dij = distance( $prototypes[$i], $data[$j] );        $performance_index +=            ($current_partition_matrix[$i][$j] **              $fuzzification_factor) * $dij;    }}print "Clustering completed ...\n";for (my $i = 0; $i < $number_of_clusters; $i++) {  for (my $k = 0; $k < $columns; $k++) {    print "Prototype[$i][$k]: $prototypes[$i][$k]\n";  }}print "performance index: $performance_index\n";print "number of iterations: $iter\n";for (my $i = 0; $i < $number_of_clusters; $i++) {  for (my $j = 0; $j < $rows; $j++){    print "U[$i][$j] = $current_partition_matrix[$i][$j]\n";  }}         # ================================# initialize_partition_matrix# partition_matrix = #   initialize_partition_matrix(#     num_clusters, num_patterns)# ================================sub initialize_partition_matrix {  srand;  my (@partition_matrix, @column_sum);    for (my $i = 0; $i < $_[0]; $i++){    for (my $j = 0; $j < $_[1]; $j++){      $partition_matrix[$i][$j] = rand;      $column_sum[$j] += $partition_matrix[$i][$j];    }  }    for (my $i = 0; $i < $_[0]; $i++){    for (my $j = 0; $j < $_[1]; $j++){      die "column [$j] sum is equal to zero\n"         unless $column_sum[$j];      $partition_matrix[$i][$j] /= $column_sum[$j];          }  }  return @partition_matrix;}# ====================================# compute distance between two vectors# dist = distance( vector1, vector2 )# ====================================sub distance {  my $vector1 = shift;  my $vector2 = shift;  my $sum = 0;  for ( my $i = 0; $i < scalar @{$vector1}; $i++ ){    my $difference = ${ $vector1 }[$i] - ${ $vector2 }[$i];    $sum += $difference * $difference;  }  return sqrt( $sum );}__DATA__0 01 11 00 11 212 1110 1112 1012 1213 112 22 010 12

ChrisCantrall's scratchpad (ChrisCantrall)

davido has a good recommended reading list - listed in order of what to tackle.

cq's scratchpad (cq)

~/.cpan/build/PathTools-3.19 $ make installCannot forceunlink /usr/lib/perl5/5.8/cygwin/auto/Cwd/Cwd.dll: Permission denied at /usr/lib/perl5/5.8/File/Find.pm line 907make: *** pure_perl_install Error 13

phemal's scratchpad (phemal)

Scratchpad - no content

ocs's scratchpad (ocs)

Scratchpad - no content

mega's scratchpad (mega)

Scratchpad - no content

Please enter your first name:
Please enter your email:

Please enter some text:

Choose a text color:
Choose a background color: