Add:
Code
Short description
Tags

Like: create mysql user Like: mysql, bash, server

public

add it or cancel

IMPORTANT!

Snipt is going open source. We've toyed with this idea for quite a while, and have finally decided it's the right way to move forward.

A few things:

The entire Snipt source code will be released on GitHub under the 3-clause BSD License on Friday, September 10th.
While we'd like to think we're perfect, we realize we're only human. By open sourcing the software that runs this website, certain bugs or security flaws may be discovered that could compromise the privacy of your snipts.
Only the Lion Burger team will be able to push commits to the Snipt.net site. Contributors should send a pull request to add new features or submit patches.
By using this site, you agree not to be too angry or take any legal action against Lion Burger should this whole thing go up in flames some day.
Follow us on Twitter for updates.

I agree, close this message

Latest 100 public snipts » perl

showing 1-20 of 43 snipts for perl

∞ Converts windows line ending to Unix/Linux line ending
```
perl -pi -e 's/\r\n/\n/g' <input-file>
```
```
bash
```
1

Converts windows line ending to Unix/Linux line ending
```
perl -pi -e 's/\r\n/\n/g' <input-file>
```
copy | embed

0 comments - tagged in
- bash,
- coding,
- lineending,
- perl
posted by mailo on Jul 20, 2010 at 3:58 p.m. EDT

∞ Perl to get html form input values

#!/usr/bin/perl
my @values;
foreach my $file (@ARGV) {
open(FILE, $file) || die "can't open file";
while( defined($line = <FILE>)) {
	chomp $line;
	if ($line =~ m/<input/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	elsif ($line =~ m/<select/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	elsif ($line =~ m/<textarea/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	
}
my $elems = join ", ", @values;
	print "$elems\n";
# foreach my $elem (@values){
# 	print "$elem\n";
# 	}
}

perl

#!/usr/bin/perl
my @values;
foreach my $file (@ARGV) {
open(FILE, $file) || die "can't open file";
while( defined($line = <FILE>)) {
	chomp $line;
	if ($line =~ m/<input/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	elsif ($line =~ m/<select/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	elsif ($line =~ m/<textarea/) {
		$line =~ m/name=["'](\w*)["']/;
		push @values, $1;
	}
	
}
my $elems = join ", ", @values;
	print "$elems\n";
# foreach my $elem (@values){
# 	print "$elem\n";
# 	}
}

copy | embed

0 comments - tagged in

posted by bradrice on Jul 08, 2010 at 2:25 p.m. EDT

∞ Print a random element in an Array

#!/usr/bin/perl

use strict;

# Declare an Array
my @coins = ("Quarter","Dime","Nickel");

# Print a random element
print $coins[rand @coins];

perl

#!/usr/bin/perl

use strict;

# Declare an Array
my @coins = ("Quarter","Dime","Nickel");

# Print a random element
print $coins[rand @coins];

copy | embed

0 comments - tagged in

posted by alwaysonnet on Jun 06, 2010 at 12:09 p.m. EDT

∞ uncompress css stylesheet

# quick one-liner to uncompress a stylesheet that has been 
# compressed down to one line. This will add the newlines back.
perl -pi -e "s/\}/\}\n/g" *.css

perl

# quick one-liner to uncompress a stylesheet that has been 
# compressed down to one line. This will add the newlines back.
perl -pi -e "s/\}/\}\n/g" *.css

copy | embed

0 comments - tagged in

posted by jrguitar21 on May 17, 2010 at 6:03 p.m. EDT

∞ directory tree traversal without File::Find

# this script takes an optional command-line argument, which is the directory to start in
# if no argument is passed, it starts in the current directory
# as is, the script simply prints the path for each plain file in the tree
# a comment indicates where code should be added to execute some action on each file
#
$startDir = $ARGV[0] or '.';
traverse($startDir);

sub traverse 
{
  local($dir) = shift;
  local($path);
  unless (opendir(DIR, $dir)) {
    warn "Can't open $dir\n";
    closedir(DIR);
    return;
  }
  foreach (readdir(DIR)) {
    next if $_ eq '.' || $_ eq '..';
    $path = "$dir/$_";
    if (-d $path) {   # a directory
      traverse($path);
    }
    elsif (-f $path) {  # a plain file
      print "$path\n";
      # add code here to execute some action on the file
    }
  }
  closedir(DIR);
}

perl

# this script takes an optional command-line argument, which is the directory to start in
# if no argument is passed, it starts in the current directory
# as is, the script simply prints the path for each plain file in the tree
# a comment indicates where code should be added to execute some action on each file
#
$startDir = $ARGV[0] or '.';
traverse($startDir);

sub traverse 
{
  local($dir) = shift;
  local($path);
  unless (opendir(DIR, $dir)) {
    warn "Can't open $dir\n";
    closedir(DIR);
    return;
  }
  foreach (readdir(DIR)) {
    next if $_ eq '.' || $_ eq '..';
    $path = "$dir/$_";
    if (-d $path) {   # a directory
      traverse($path);
    }
    elsif (-f $path) {  # a plain file
      print "$path\n";
      # add code here to execute some action on the file
    }
  }
  closedir(DIR);
}

copy | embed

0 comments - tagged in

posted by paulmlieberman on Apr 12, 2010 at 10:01 a.m. EDT

∞ How to pull values out of closures

use strict;
use warnings;
use PadWalker qw(closed_over);

sub gen {
    my $var = shift;
    return sub { my $a = $var;  $a *= 2; return $a };
}

my $closed_sub = gen(123);

print $closed_sub->() . "\n";

my $closed_value =  ${closed_over($closed_sub)->{'$var'}};

print $closed_value . "\n";

perl

use strict;
use warnings;
use PadWalker qw(closed_over);

sub gen {
    my $var = shift;
    return sub { my $a = $var;  $a *= 2; return $a };
}

my $closed_sub = gen(123);

print $closed_sub->() . "\n";

my $closed_value =  ${closed_over($closed_sub)->{'$var'}};

print $closed_value . "\n";

copy | embed

0 comments - tagged in

padwalker,
perl

posted by absolut_todd on Feb 24, 2010 at 12:56 a.m. EST

∞ Converting from date to epoch time

#!/usr/bin/perl
use Time::Local
 
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
$time = timegm($sec,$min,$hour,$mday,$mon,$year);

# Allowed range values

#    * day of the month: 1..31
#    * month: 0..11 (0 = January, 1 = February, etc)
#    * year:
#          o If value>999: the value is interpreted as the actual year
#          o If value is 100..999: the value is interpreted as an offset #from 1900 (for example, 199 is considered year 2099)
#          o If value is 0..99: the value is interpreted based on the current year: if the current year is in the second half of the century #(for example 1970), then the values in the range 50..99 are considered of be in the current century and the values in the range 0..49 are in the next century. If the current year is in the first half of the century (for example 2007), then the range 0..49 is interpreted as values in the current century and the range 50..99 is interpreted as years from the #previous century.

perl

#!/usr/bin/perl
use Time::Local
 
$time = timelocal($sec,$min,$hour,$mday,$mon,$year);
$time = timegm($sec,$min,$hour,$mday,$mon,$year);

# Allowed range values

#    * day of the month: 1..31
#    * month: 0..11 (0 = January, 1 = February, etc)
#    * year:
#          o If value>999: the value is interpreted as the actual year
#          o If value is 100..999: the value is interpreted as an offset #from 1900 (for example, 199 is considered year 2099)
#          o If value is 0..99: the value is interpreted based on the current year: if the current year is in the second half of the century #(for example 1970), then the values in the range 50..99 are considered of be in the current century and the values in the range 0..49 are in the next century. If the current year is in the first half of the century (for example 2007), then the range 0..49 is interpreted as values in the current century and the range 50..99 is interpreted as years from the #previous century.

copy | embed

0 comments - tagged in

posted by yvoictra on Jan 25, 2010 at 4:29 p.m. EST

∞ Perl trim function to strip whitespace from a string

#!/usr/bin/perl

# Declare the subroutines
sub trim($);
sub ltrim($);
sub rtrim($);

# Create a test string
my $string = "  \t  Hello world!   ";

# Here is how to output the trimmed text "Hello world!"
print trim($string)."\n";
print ltrim($string)."\n";
print rtrim($string)."\n";

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}

perl

#!/usr/bin/perl

# Declare the subroutines
sub trim($);
sub ltrim($);
sub rtrim($);

# Create a test string
my $string = "  \t  Hello world!   ";

# Here is how to output the trimmed text "Hello world!"
print trim($string)."\n";
print ltrim($string)."\n";
print rtrim($string)."\n";

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
	my $string = shift;
	$string =~ s/\s+$//;
	return $string;
}

copy | embed

0 comments - tagged in

posted by yvoictra on Jan 24, 2010 at 8:53 p.m. EST

∞ Perl API to generate a Log

package uLog;

use strict;
use POSIX qw(uname strftime);
use IO::File;
# Next path is the place where MainConfig.pm is defined
use lib '/aplicaciones/plataforma/spread/smsc';
use MainConfig;

use constant TRUE        => 1;
use constant FALSE       => 0;

eval "use Time::HiRes qw(gettimeofday)";
my $HAS_TIME_HIRES = not $@;
my $NODATAFIELD    = "-";
my $DATEFORMAT     = "%F.%H:%m:%S.%Q";
my $CFG = $MainConfig::CFG;
my $DIRORDER = [ 
                 "$CFG->{paths}->{service_path}/logs/",
                 "./logs/",
                 "/tmp/" ];

my $hrefLevels = {
        FAT => 1,
        ERR => 2,
        WAR => 3,
        INF => 4,
        DEB => 5,
        VER => 6
};

my $_LOGGER;

sub _new {
        my ($args)  = @_;

        my (undef, $sHostname, undef, undef, undef) = uname();
        my $self = {
                _sLogFile  => $NODATAFIELD,
                _iLogLevel => $hrefLevels->{INF},
                _sTicket   => $NODATAFIELD,
                _sUser     => $ENV{USER} || $< || $NODATAFIELD,
                _sService  => $NODATAFIELD,
                _sMachine  => $sHostname || $NODATAFIELD,
                _LOG_FH    => undef,
                _iCounter  => 0,
                _iDelta    => undef,
                _iPID      => $$,
                _sModule   => $NODATAFIELD
        };
        bless $self, 'uLog';

        $self->_init( $args );
        $_LOGGER = $self;

        return $self;
}

sub getLogger {
        my ($args) = @_;

        return ($_LOGGER ? $_LOGGER : uLog::_new ( $args ));
}

sub _init {
        my ($self, $args) = @_;

        my ($sApp) = ($0 =~ /.*\/(.*)/);
        foreach my $sKey ( keys %{ $args }) {
                my $sValue = $args->{ $sKey };
                if ($sValue) {
                        if      ($sKey eq "level") {
                                $self->{_iLogLevel} = $hrefLevels->{ $sValue } if ( $hrefLevels->{ $sValue } );
                        } elsif ($sKey eq "service") {
                                $self->{_sService} = $sValue;
                        } elsif ($sKey eq "ticket") {
                                $self->{_sTicket} = $sValue;
                        } elsif ($sKey eq "module") {
                                $self->{_sModule} = $sValue;
                        }
                }
        }
        my $sFileName = ($self->{_sService} eq $NODATAFIELD ? $sApp : $self->{_sService});
        $sFileName .= ($self->{_sModule} eq $NODATAFIELD ? "" : "_" . $self->{_sModule}) . ".log";
        foreach my $sDir (@{ $DIRORDER }) {
                if (-w $sDir) {

                        $self->{_sLogFile} = $sDir . $sFileName;
                        last;
                }
        }
}

sub _open {
        my $self = shift;

        $self->{ _LOG_FH } = new IO::File ">> " . $self->{_sLogFile} if ( $self->{_sLogFile} );
        $self->{ _LOG_FH }->autoflush( 1 );
}

sub _getLine {
        my $iCallerLevel = 2;
        my ($package, $filename, $line,
                $subroutine, $hasargs,
                $wantarray, $evaltext, $is_require, 
                $hints, $bitmask) = caller($iCallerLevel);
        $filename =~ s/^.*\///g;
        return $filename  . ":" . $line;
}

sub _round {
        my $iVal = shift;
        my $iInt = int $iVal;

        return $iVal - $iInt >= 0.5 ? $iInt + 1 : $iInt;
}

sub _log {
        my ($self, $sType, $sMsg, $iCode) = @_;

        return if ($hrefLevels->{ $sType } > $self->{_iLogLevel});
        my $iEpochSeconds      = time();
        my $iEpochMilliseconds = 0;
        if ($HAS_TIME_HIRES) {
                ($iEpochSeconds, $iEpochMilliseconds) =  Time::HiRes::gettimeofday();
                $iEpochMilliseconds = _round($iEpochMilliseconds / 1000 );
        }
        unless ($self->{_iDelta}) {
                $self->{_iDelta} = $iEpochSeconds + ($iEpochMilliseconds /1000);
        }
        $self->_open unless($self->{ _LOG_FH } && -w $self->{_sLogFile});
        return unless $self->{ _LOG_FH };
        my $tmp = $self->{ _LOG_FH };
        $sMsg =~ s/\n/\\n/gsi;
        (my $sTmpformat = $DATEFORMAT) =~ s/\%Q/$iEpochMilliseconds/g;
        my $sDelta = sprintf("%.3f", ($iEpochSeconds + ($iEpochMilliseconds /1000)) - $self->{_iDelta});
        $sTmpformat =~ s/\%q/$sDelta/g;

        (my $seg, my $min, my $hora, my $dia, my $mes, my $anho, my @zape) = localtime(time);
        $mes++;
        $anho+=1900;
        my $fecha = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $anho, $mes, $dia, $hora, $min, $seg);

        print $tmp sprintf("[%s] %s %s:%s:%s:%s:%s %s\n",
                $fecha,
                $sType,
                $self->{_sService},
                $self->{_sModule},
                $self->{_sMachine},
                $self->{_sUser},
                _getLine(),
                #$self->{_sTicket},
                #$self->{_iCounter},
                #$iCode || 0,
                $sMsg);
        $self->{_iCounter}++;
}

sub DESTROY {
        my $self = shift;
        undef $self->{ _LOG_FH } if ($self->{ _LOG_FH });
}

sub ResetDelta {
        my ( $self ) = @_;
        $self->{_iDelta} = 0;
}

sub LOG {
        my ( $self, $sType, $sMsg, $iCode ) = @_;
        $self->_log($sType, $sMsg, $iCode) if (defined $hrefLevels->{ $sType });
}

sub FAT {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("FAT", $sMsg, $iCode);
}

sub ERR {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("ERR", $sMsg, $iCode);
}

sub WAR {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("WAR", $sMsg, $iCode);
}

sub INF {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("INF", $sMsg, $iCode);
}

sub DEB {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("DEB", $sMsg, $iCode);
}

sub VER {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("VER", $sMsg, $iCode);
}

1;

perl

package uLog;

use strict;
use POSIX qw(uname strftime);
use IO::File;
# Next path is the place where MainConfig.pm is defined
use lib '/aplicaciones/plataforma/spread/smsc';
use MainConfig;

use constant TRUE        => 1;
use constant FALSE       => 0;

eval "use Time::HiRes qw(gettimeofday)";
my $HAS_TIME_HIRES = not $@;
my $NODATAFIELD    = "-";
my $DATEFORMAT     = "%F.%H:%m:%S.%Q";
my $CFG = $MainConfig::CFG;
my $DIRORDER = [ 
                 "$CFG->{paths}->{service_path}/logs/",
                 "./logs/",
                 "/tmp/" ];

my $hrefLevels = {
        FAT => 1,
        ERR => 2,
        WAR => 3,
        INF => 4,
        DEB => 5,
        VER => 6
};

my $_LOGGER;

sub _new {
        my ($args)  = @_;

        my (undef, $sHostname, undef, undef, undef) = uname();
        my $self = {
                _sLogFile  => $NODATAFIELD,
                _iLogLevel => $hrefLevels->{INF},
                _sTicket   => $NODATAFIELD,
                _sUser     => $ENV{USER} || $< || $NODATAFIELD,
                _sService  => $NODATAFIELD,
                _sMachine  => $sHostname || $NODATAFIELD,
                _LOG_FH    => undef,
                _iCounter  => 0,
                _iDelta    => undef,
                _iPID      => $$,
                _sModule   => $NODATAFIELD
        };
        bless $self, 'uLog';

        $self->_init( $args );
        $_LOGGER = $self;

        return $self;
}

sub getLogger {
        my ($args) = @_;

        return ($_LOGGER ? $_LOGGER : uLog::_new ( $args ));
}

sub _init {
        my ($self, $args) = @_;

        my ($sApp) = ($0 =~ /.*\/(.*)/);
        foreach my $sKey ( keys %{ $args }) {
                my $sValue = $args->{ $sKey };
                if ($sValue) {
                        if      ($sKey eq "level") {
                                $self->{_iLogLevel} = $hrefLevels->{ $sValue } if ( $hrefLevels->{ $sValue } );
                        } elsif ($sKey eq "service") {
                                $self->{_sService} = $sValue;
                        } elsif ($sKey eq "ticket") {
                                $self->{_sTicket} = $sValue;
                        } elsif ($sKey eq "module") {
                                $self->{_sModule} = $sValue;
                        }
                }
        }
        my $sFileName = ($self->{_sService} eq $NODATAFIELD ? $sApp : $self->{_sService});
        $sFileName .= ($self->{_sModule} eq $NODATAFIELD ? "" : "_" . $self->{_sModule}) . ".log";
        foreach my $sDir (@{ $DIRORDER }) {
                if (-w $sDir) {

                        $self->{_sLogFile} = $sDir . $sFileName;
                        last;
                }
        }
}

sub _open {
        my $self = shift;

        $self->{ _LOG_FH } = new IO::File ">> " . $self->{_sLogFile} if ( $self->{_sLogFile} );
        $self->{ _LOG_FH }->autoflush( 1 );
}

sub _getLine {
        my $iCallerLevel = 2;
        my ($package, $filename, $line,
                $subroutine, $hasargs,
                $wantarray, $evaltext, $is_require, 
                $hints, $bitmask) = caller($iCallerLevel);
        $filename =~ s/^.*\///g;
        return $filename  . ":" . $line;
}

sub _round {
        my $iVal = shift;
        my $iInt = int $iVal;

        return $iVal - $iInt >= 0.5 ? $iInt + 1 : $iInt;
}

sub _log {
        my ($self, $sType, $sMsg, $iCode) = @_;

        return if ($hrefLevels->{ $sType } > $self->{_iLogLevel});
        my $iEpochSeconds      = time();
        my $iEpochMilliseconds = 0;
        if ($HAS_TIME_HIRES) {
                ($iEpochSeconds, $iEpochMilliseconds) =  Time::HiRes::gettimeofday();
                $iEpochMilliseconds = _round($iEpochMilliseconds / 1000 );
        }
        unless ($self->{_iDelta}) {
                $self->{_iDelta} = $iEpochSeconds + ($iEpochMilliseconds /1000);
        }
        $self->_open unless($self->{ _LOG_FH } && -w $self->{_sLogFile});
        return unless $self->{ _LOG_FH };
        my $tmp = $self->{ _LOG_FH };
        $sMsg =~ s/\n/\\n/gsi;
        (my $sTmpformat = $DATEFORMAT) =~ s/\%Q/$iEpochMilliseconds/g;
        my $sDelta = sprintf("%.3f", ($iEpochSeconds + ($iEpochMilliseconds /1000)) - $self->{_iDelta});
        $sTmpformat =~ s/\%q/$sDelta/g;

        (my $seg, my $min, my $hora, my $dia, my $mes, my $anho, my @zape) = localtime(time);
        $mes++;
        $anho+=1900;
        my $fecha = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $anho, $mes, $dia, $hora, $min, $seg);

        print $tmp sprintf("[%s] %s %s:%s:%s:%s:%s %s\n",
                $fecha,
                $sType,
                $self->{_sService},
                $self->{_sModule},
                $self->{_sMachine},
                $self->{_sUser},
                _getLine(),
                #$self->{_sTicket},
                #$self->{_iCounter},
                #$iCode || 0,
                $sMsg);
        $self->{_iCounter}++;
}

sub DESTROY {
        my $self = shift;
        undef $self->{ _LOG_FH } if ($self->{ _LOG_FH });
}

sub ResetDelta {
        my ( $self ) = @_;
        $self->{_iDelta} = 0;
}

sub LOG {
        my ( $self, $sType, $sMsg, $iCode ) = @_;
        $self->_log($sType, $sMsg, $iCode) if (defined $hrefLevels->{ $sType });
}

sub FAT {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("FAT", $sMsg, $iCode);
}

sub ERR {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("ERR", $sMsg, $iCode);
}

sub WAR {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("WAR", $sMsg, $iCode);
}

sub INF {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("INF", $sMsg, $iCode);
}

sub DEB {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("DEB", $sMsg, $iCode);
}

sub VER {
        my ( $self, $sMsg, $iCode ) = @_;
        $self->_log("VER", $sMsg, $iCode);
}

1;

copy | embed

0 comments - tagged in

posted by yvoictra on Jan 16, 2010 at 4:14 a.m. EST

∞ Calculate Process Duration in Perl

#!/usr/bin/perl

use Time::HiRes qw(gettimeofday tv_interval);

my $start_time = [gettimeofday];

for(my $i=0;$i<1000000;$i++)
{
    my $cool = 1;
}

my $total_time = tv_interval($start_time);

print "Process time: $total_time seconds\n";

perl

#!/usr/bin/perl

use Time::HiRes qw(gettimeofday tv_interval);

my $start_time = [gettimeofday];

for(my $i=0;$i<1000000;$i++)
{
    my $cool = 1;
}

my $total_time = tv_interval($start_time);

print "Process time: $total_time seconds\n";

copy | embed

0 comments - tagged in

posted by yvoictra on Jan 15, 2010 at 5:24 p.m. EST

∞ Getting actual date in Perl

$DDMMYYHHMMSS = sprintf("%02d/%02d/%04d %02d:%02d:%02d", sub{($_[3],$_[4]+1,$_[5]+1900,$_[2],$_[1]),$_[0]}->(localtime(time())));

perl

$DDMMYYHHMMSS = sprintf("%02d/%02d/%04d %02d:%02d:%02d", sub{($_[3],$_[4]+1,$_[5]+1900,$_[2],$_[1]),$_[0]}->(localtime(time())));

copy | embed

0 comments - tagged in

posted by yvoictra on Jan 14, 2010 at 6:40 p.m. EST

∞ Quick Circle Area Calculator

#!/usr/bin/perl -w
use strict;
print "\nR = "; print "A = ", (<>**2)*3.1415, "\n\n";

perl

#!/usr/bin/perl -w
use strict;
print "\nR = "; print "A = ", (<>**2)*3.1415, "\n\n";

copy | embed

0 comments - tagged in

posted by DrAlexJ on Dec 30, 2009 at 4:01 p.m. EST

∞ Generate a generic GNU makefile for the current directory.

#!/usr/bin/perl -w

# generate a gnu makefile in the current dir.

die "Makefile already exists!\n" if (-f 'Makefile');    
my $target = shift(@ARGV) or die "No target name!\n";
my @src = grep /\.cc?$|\.cpp$|\.cxx$/, <*>;

die "No source files!\n" if (!@src);
@src = sort(@src);
my @exts = map { m/\.(.*)$/; $1; } @src;
my $prev_ext = $exts[0];
for (@exts) {
    die "Mixed in extensions in source files!\n" if ($_ ne $prev_ext);
}

# choose between c and c++ based on file extensions. if it is not c,
# then assume it is c++

if ($exts[0] eq "c") {
    $comp_mac = "CC";
    $comp_flags_mac = "CFLAGS";
    $comp = "gcc";
} else {    
    $comp_mac = "CXX";
    $comp_flags_mac = "CXXFLAGS";
    $comp = "g++";
}

# write out the makefile...

local *F;
open(F, ">Makefile") or die "Can't open Makefile: $!";
select(F);
print<<MF;

EXE = $target
SRC = @src
OBJ = \$(patsubst %.${exts[0]}, %.o, \$(SRC))
DEP = \$(patsubst %.${exts[0]}, .%.d, \$(SRC))

$comp_mac = $comp
$comp_flags_mac = -g -Wall
LDFLAGS =

.%.d : %.${exts[0]}
\t\$\($comp_mac\) -MM \$< > \$@

\$(EXE): \$(OBJ)
\t\$\($comp_mac\) \$(LDFLAGS) -o \$(EXE) \$(OBJ)

-include \$(DEP)

.PHONY: clean distclean

clean:
\t-\$(RM) \$(EXE)
\t-\$(RM) \$(OBJ)

distclean: clean
\t-\$(RM) \$(DEP)
\t-\$(RM) *~
\t-\$(RM) core

MF
close(F);
exit(0);

perl

#!/usr/bin/perl -w

# generate a gnu makefile in the current dir.

die "Makefile already exists!\n" if (-f 'Makefile');    
my $target = shift(@ARGV) or die "No target name!\n";
my @src = grep /\.cc?$|\.cpp$|\.cxx$/, <*>;

die "No source files!\n" if (!@src);
@src = sort(@src);
my @exts = map { m/\.(.*)$/; $1; } @src;
my $prev_ext = $exts[0];
for (@exts) {
    die "Mixed in extensions in source files!\n" if ($_ ne $prev_ext);
}

# choose between c and c++ based on file extensions. if it is not c,
# then assume it is c++

if ($exts[0] eq "c") {
    $comp_mac = "CC";
    $comp_flags_mac = "CFLAGS";
    $comp = "gcc";
} else {    
    $comp_mac = "CXX";
    $comp_flags_mac = "CXXFLAGS";
    $comp = "g++";
}

# write out the makefile...

local *F;
open(F, ">Makefile") or die "Can't open Makefile: $!";
select(F);
print<<MF;

EXE = $target
SRC = @src
OBJ = \$(patsubst %.${exts[0]}, %.o, \$(SRC))
DEP = \$(patsubst %.${exts[0]}, .%.d, \$(SRC))

$comp_mac = $comp
$comp_flags_mac = -g -Wall
LDFLAGS =

.%.d : %.${exts[0]}
\t\$\($comp_mac\) -MM \$< > \$@

\$(EXE): \$(OBJ)
\t\$\($comp_mac\) \$(LDFLAGS) -o \$(EXE) \$(OBJ)

-include \$(DEP)

.PHONY: clean distclean

clean:
\t-\$(RM) \$(EXE)
\t-\$(RM) \$(OBJ)

distclean: clean
\t-\$(RM) \$(DEP)
\t-\$(RM) *~
\t-\$(RM) core

MF
close(F);
exit(0);

copy | embed

0 comments - tagged in

makefile,
perl

posted by marcbutler on Dec 25, 2009 at 12:05 a.m. EST

∞ update drupal from subversion tags

# Update a Drupal minor revision using a patch file.
# Creating a patch file between cvs tags on the server proved to be 
# impossible. I've found a way to do this with a subversion mirror
# of Drupal core.

cd ~/path/to/local/drupal

# What is current version of Drupal?
cat CHANGELOG.txt | grep Drupal | head -1
## Drupal 6.13, 2009-07-01

# I'm using a Subversion mirror of Drupal core to create the patch.
# (Thanks to the guys at subversible.com!)
svn diff http://subversible.com/svn/drupal/tags/DRUPAL-6-13 \ 
         http://subversible.com/svn/drupal/tags/DRUPAL-6-14 > d6-14.patch 

# The local version of drupal was created from a tarball, and the date 
# format inside the $Id$ (from CVS) is: YYYY/mm/dd HH:MM:SS,  but in the 
# subversion patch it was YYYY-mm-dd HH:MM:SS.  So I had to this quick 
# find/replace in order to get the patch to apply cleanly.
perl -pi -e 's/(\d{4})-(\d{2})-(\d{2})\s(\d{2})/\1\/\2\/\3 \4/g' d6-14.patch


# Check to see if you have any outstanding uncommitted local changes. If
# there are some changes then execute the commit (commented out below).
svn status
#svn commit -m "latest changes prior to drupal core update"

# Apply the patch.  The patch from svn diff command should be in 
# unified diff format (-u) and the paths should be taken as they are so 
# files in subfolders are matched (-p0).
patch -p0 -u <d6-14.patch


#dont forget to commit the updates...
svn commit -m "updated core drupal"

#optionally, tag the updated code in the repository

bash

# Update a Drupal minor revision using a patch file.
# Creating a patch file between cvs tags on the server proved to be 
# impossible. I've found a way to do this with a subversion mirror
# of Drupal core.

cd ~/path/to/local/drupal

# What is current version of Drupal?
cat CHANGELOG.txt | grep Drupal | head -1
## Drupal 6.13, 2009-07-01

# I'm using a Subversion mirror of Drupal core to create the patch.
# (Thanks to the guys at subversible.com!)
svn diff http://subversible.com/svn/drupal/tags/DRUPAL-6-13 \ 
         http://subversible.com/svn/drupal/tags/DRUPAL-6-14 > d6-14.patch 

# The local version of drupal was created from a tarball, and the date 
# format inside the $Id$ (from CVS) is: YYYY/mm/dd HH:MM:SS,  but in the 
# subversion patch it was YYYY-mm-dd HH:MM:SS.  So I had to this quick 
# find/replace in order to get the patch to apply cleanly.
perl -pi -e 's/(\d{4})-(\d{2})-(\d{2})\s(\d{2})/\1\/\2\/\3 \4/g' d6-14.patch


# Check to see if you have any outstanding uncommitted local changes. If
# there are some changes then execute the commit (commented out below).
svn status
#svn commit -m "latest changes prior to drupal core update"

# Apply the patch.  The patch from svn diff command should be in 
# unified diff format (-u) and the paths should be taken as they are so 
# files in subfolders are matched (-p0).
patch -p0 -u <d6-14.patch


#dont forget to commit the updates...
svn commit -m "updated core drupal"

#optionally, tag the updated code in the repository

copy | embed

0 comments - tagged in

posted by jrguitar21 on Dec 11, 2009 at 7:45 p.m. EST

∞ Number Set Calculator

#!/usr/bin/perl -w
use strict;

# header
print "||---	Number Set Calculator\n\n";


# input
my @set = ( );
if (@ARGV){
	open(DAT, $ARGV[0]) or die "Error: $!";
	@set = split(/ /, <DAT>);
	close(DAT) or die "Error: $!"; # input for file
	} else {
	print "* Input numbers separated by spaces: "; @set = split(/ /, <>); # manual
}

# print sorted array
sub nmc { $a <=> $b; } chomp(@set = sort nmc @set);
print "\n||---	Sorted Set: (", join(", ",@set), ")\n";

# print total & average
my $ttl = 0; ($ttl += $_) for @set;
print "||---	Total: ", $ttl, "\n";
print "||---	Average: ", $ttl/@set, "\n";

# print median
(grep(/.5/i,@set/2)) ?
print "||---	Median: ", $set[@set/2-.5], "\n" : # if odd
print "||---	Median: ", ($set[@set/2-1] + $set[@set/2])/2, "\n"; # if even

# print min / max, & range
print "||---	Min => Max: (", $set[0], " => ", $set[-1], ")\n";
print "||---	Range: ", $set[-1] - $set[0], "\n\n";

perl

#!/usr/bin/perl -w
use strict;

# header
print "||---	Number Set Calculator\n\n";


# input
my @set = ( );
if (@ARGV){
	open(DAT, $ARGV[0]) or die "Error: $!";
	@set = split(/ /, <DAT>);
	close(DAT) or die "Error: $!"; # input for file
	} else {
	print "* Input numbers separated by spaces: "; @set = split(/ /, <>); # manual
}

# print sorted array
sub nmc { $a <=> $b; } chomp(@set = sort nmc @set);
print "\n||---	Sorted Set: (", join(", ",@set), ")\n";

# print total & average
my $ttl = 0; ($ttl += $_) for @set;
print "||---	Total: ", $ttl, "\n";
print "||---	Average: ", $ttl/@set, "\n";

# print median
(grep(/.5/i,@set/2)) ?
print "||---	Median: ", $set[@set/2-.5], "\n" : # if odd
print "||---	Median: ", ($set[@set/2-1] + $set[@set/2])/2, "\n"; # if even

# print min / max, & range
print "||---	Min => Max: (", $set[0], " => ", $set[-1], ")\n";
print "||---	Range: ", $set[-1] - $set[0], "\n\n";

copy | embed

0 comments - tagged in

posted by DrAlexJ on Nov 01, 2009 at 12:46 p.m. EST

∞ Quick Circumference Calculator
```
#!/usr/bin/perl -w
use strict;
print "\nR = "; print "C = ", <>*6.2832, "\n\n";
```
```
perl
```
1

Quick Circumference Calculator
```
#!/usr/bin/perl -w
use strict;
print "\nR = "; print "C = ", <>*6.2832, "\n\n";
```
copy | embed

0 comments - tagged in
- circumference,
- input,
- no variable,
- perl,
- raidus
posted by DrAlexJ on Nov 01, 2009 at 12:44 p.m. EST

∞ Purge Directory

use strict;

# This file is used to remove old log files from the given directories.
# The syntax of the file is
# 		perl purgeMigrationDirectory.pl DirectoryName NumberOfDaysToPurge
#
# This will remove all old log files that are older than ARGV[1] days old
# Old log files include any text file with _error.txt _log.txt _export.xml _audit.txt
# It will not remove any other folders or files

if(($#ARGV + 1) == 2){
	&startThePurge($ARGV[0], $ARGV[1]);	
}

else{
	&printHelp();
}

#print help message to the console if the correct number of arguments are not supplied
sub printHelp{
	print "You must provide the full path of the directory you wish to " .
		  "purge of old migration log files and the number of days back you wish to purge.\nExample:\n\n" .
		  "perl purgeMigrationDirectory.pl 'C:\\ICC Migration Tool\\InformaticaOutputDir' 60 would purge the directory of any of the log files that are older than 60 days.\n\n" .
		  "See the script for more details.";
}

#purge migration log files
sub startThePurge{
	
	#check to see if the directory exists
	if (-d @_[0]){
		my $inputDir = shift;
		my $numFilesRemoved = 0;
		my $numDays = shift;
		
		print "Removing old migration files from " . $inputDir . " that are older than " . localtime(time() - 60*60*24*$numDays) ."\n";
		
		#open input directory
		opendir(DIR, $inputDir);
		
		#only look at files with the following appends
		#_error.txt
		#_log.txt
		#_audit.txt
		#_export.xml
		#_query.txt
		#_cntl.txt
		foreach my $file (grep { /_(error.txt|log.txt|audit.txt|query.txt|cntl.txt|export.xml)$/} readdir DIR) {
			my $tempdm = (stat $inputDir . "\\" . $file)[9];
			my $age = int(-M $inputDir . "\\" . $file);
			if($age >= $numDays){ #remove files older than two months
				print "Removing file " . $file . " because it was last modified on " . localtime($tempdm) . " days old.\n";
				unlink($inputDir . "\\" . $file); #remove file
				$numFilesRemoved = $numFilesRemoved + 1;
			}
		}
		
		print "Removed " . $numFilesRemoved . " files from " . $inputDir . "\n";
	}
	
	#directory does not exist
	else{
		print STDERR @_[0] . " does not exist.  Please try again";
	}
}

perl

use strict;

# This file is used to remove old log files from the given directories.
# The syntax of the file is
# 		perl purgeMigrationDirectory.pl DirectoryName NumberOfDaysToPurge
#
# This will remove all old log files that are older than ARGV[1] days old
# Old log files include any text file with _error.txt _log.txt _export.xml _audit.txt
# It will not remove any other folders or files

if(($#ARGV + 1) == 2){
	&startThePurge($ARGV[0], $ARGV[1]);	
}

else{
	&printHelp();
}

#print help message to the console if the correct number of arguments are not supplied
sub printHelp{
	print "You must provide the full path of the directory you wish to " .
		  "purge of old migration log files and the number of days back you wish to purge.\nExample:\n\n" .
		  "perl purgeMigrationDirectory.pl 'C:\\ICC Migration Tool\\InformaticaOutputDir' 60 would purge the directory of any of the log files that are older than 60 days.\n\n" .
		  "See the script for more details.";
}

#purge migration log files
sub startThePurge{
	
	#check to see if the directory exists
	if (-d @_[0]){
		my $inputDir = shift;
		my $numFilesRemoved = 0;
		my $numDays = shift;
		
		print "Removing old migration files from " . $inputDir . " that are older than " . localtime(time() - 60*60*24*$numDays) ."\n";
		
		#open input directory
		opendir(DIR, $inputDir);
		
		#only look at files with the following appends
		#_error.txt
		#_log.txt
		#_audit.txt
		#_export.xml
		#_query.txt
		#_cntl.txt
		foreach my $file (grep { /_(error.txt|log.txt|audit.txt|query.txt|cntl.txt|export.xml)$/} readdir DIR) {
			my $tempdm = (stat $inputDir . "\\" . $file)[9];
			my $age = int(-M $inputDir . "\\" . $file);
			if($age >= $numDays){ #remove files older than two months
				print "Removing file " . $file . " because it was last modified on " . localtime($tempdm) . " days old.\n";
				unlink($inputDir . "\\" . $file); #remove file
				$numFilesRemoved = $numFilesRemoved + 1;
			}
		}
		
		print "Removed " . $numFilesRemoved . " files from " . $inputDir . "\n";
	}
	
	#directory does not exist
	else{
		print STDERR @_[0] . " does not exist.  Please try again";
	}
}

copy | embed

0 comments - tagged in

posted by elaforc on Sep 28, 2009 at 9:59 a.m. EDT

∞ replaces instances of "SEARCH" with "REPLACE" in files matching "*.txt"
```
perl -pi -w -e 's/SEARCH/REPLACE/g;' *.txt
```
```
bash
```
1

replaces instances of "SEARCH" with "REPLACE" in files matching "*.txt"
```
perl -pi -w -e 's/SEARCH/REPLACE/g;' *.txt
```
copy | embed

0 comments - tagged in
- bash,
- perl
posted by jonbiddle on Aug 14, 2009 at 3:58 p.m. EDT

∞ Perl recursive replace

#Perl provides a really nice one-line for this kind of thing:

perl -p -i -e ’s///g’ *

#It also provides the option of creating a backup of each file changed:

perl -p -i.bak -e ’s///g’ *

perl

#Perl provides a really nice one-line for this kind of thing:

perl -p -i -e ’s///g’ *

#It also provides the option of creating a backup of each file changed:

perl -p -i.bak -e ’s///g’ *

copy | embed

0 comments - tagged in

posted by tayhimself on Aug 12, 2009 at 7:49 p.m. EDT

∞ replace specific line within a script

perl -p -i -e 's/nfs\/cl0[0-9]\/h[0-9][0-9]\/mnt/home/g' lame.php
sed 's:/nfs/cl[0-9][0-9]/h[0-9][0-9]/mnt:/home:g' lame.php

bash

perl -p -i -e 's/nfs\/cl0[0-9]\/h[0-9][0-9]\/mnt/home/g' lame.php
sed 's:/nfs/cl[0-9][0-9]/h[0-9][0-9]/mnt:/home:g' lame.php

copy | embed

0 comments - tagged in

posted by malkir on Aug 07, 2009 at 5:52 p.m. EDT

1 2 3 next ››

Latest 100 public snipts » perl

Top 40 public tags