package MyPackage;

#module code goes here...

1;

#dump a hash
while (my ($key, $value) = each %target_list)
    {
	print "$key=>$value \n";
    }

#dump an array
for (@list){print "$_\n";}

#print the result of search-and-replace to the terminal
perl -pe 's/bart/milhouse/g' test.html

#search-and-replace, with backup
#leave the suffix off of -i to overwrite
perl -i.bak -pe 's/bart/milhouse/g' test.html

#echo the number of lines in a file
 perl -lne 'END { print $t } @w = /(\w+)/g; $t += @w' test.html

#cat file with line numbers
# -p prints $_ each iteration
perl -pe '$_ = "$. = $_"' test.html


# recursive search-and-replace, only on shells that support file globs
perl -i.bak -pe 's{bart}{milhouse}' **/*html

$logfile = "/tmp/mylog.txt";
open STDOUT, ">>", $logfile or die "cannot append to '$logfile': $!\n";
open STDERR, ">&STDOUT" or die "cannot dup STDERR to STDOUT: $!\n";
select STDERR; $| = 1;
open LOG, ">&STDOUT" or die "cannot dup LOG to STDOUT: $!\n";
select LOG; $| = 1;
select STDOUT; $| = 1;

#!/usr/bin/perl -w
use strict;
use utf8;
use encoding "utf8";
use Getopt::Std;
use Text::BibTeX;
#
getopt();
our $opt_r;
die "Usage : $0 [-r] source-file dest-file\n" if !defined( $ARGV[1] ) ;
#
my $oldfile = shift;
open BIBFILE1, '<:utf8', $oldfile or die "Problem opening $oldfile\n";
my $newfile = shift;
open BIBFILE2, '>:utf8', $newfile or die "Problem opening $newfile\n";
#
while (my  $entry = new Text::BibTeX::Entry $oldfile, \*BIBFILE1)
{
	next if !$entry->parse_ok;
	my $keywords = $entry->get ('keywords');
	next if !defined($keywords);
#	my $title = $entry->get ('title');
#	print "$title:\n" if (defined($title));
#	print "$keywords\n-->\n";
##
	my $tags;
	if (!$opt_r) {
		my @list = split (",", $keywords);
		foreach (@list) {s/^ //g; s/ $//g; s/ /_/g};
		$tags = join(' ', @list);
	}
	else {
#		print "reverse\n";
		my @list = split (" ", $keywords);
		foreach (@list) {s/_/ /g};
		$tags = join(', ', @list);
	}	 
#	print "/", $tags, "/\n\n";
##	
	$entry->set ('keywords', $tags);
	$entry->print  (\*BIBFILE2);
}

#!/usr/bin/perl -w
use strict;
# use File::stat; # for detailed print out
use Getopt::Std;
#
### get options and the argument from the command line
my %opts;
getopts("amc", \%opts);
my $operator='-M';		# date modified to present
if ($opts{'a'}) {$op='-A'};	# date accessed to present
if ($opts{'c'}) {$op='-C'};	# inode change time to present
#
my $path = shift 
	or die "Usage: $0 [ -a | -m | -c] path\n";
opendir my($dir), $path
	or die "Can't open $path : $!\n";

#
### store file names sorted by modification or access date
#
my @files = sort { eval($operator.' "$path/$a" <=> '.$operator.' "$path/$b"') }
	grep { -f "$path/$_" }	
		readdir $dir;
#
### with -M operator in clear
#
# my @files = sort { -M "$path/$a" <=> -M "$path/$b" } 
#	grep { -f "$path/$_" }	
#		readdir $dir;
### same with -A and -C
#
closedir $dir;
#
### Simple print out
# foreach my $file (@files) {print "$file\n";};
#
### Detailed print out
# foreach my $file (@files) {my $sb = stat("$path/$file"); printf "%s : last modified on %s, last accessed on %s\n", $file, scalar localtime $sb->mtime, scalar localtime $sb->atime;}

#!/usr/bin/perl -w
use strict;
use Frontier::Client;

my $key = '';			# (your API key)
my $user = '';			# used to skip others' snippets (fill with your user name)

my $session = Frontier::Client->new( url => 'http://snipplr.com/xml-rpc.php', debug => 0,);

$session->call('user.checkkey', $key) 
	or die "Provided key has been refused!\n";

my @args = ($key, '');
my $list = $session->call('snippet.list', @args);

my @snippets;		# in case you need to process data afterwards (sort ...)

for (my $i=0 ; defined($_ = $list->[$i]) ; $i++) {
	my $data = $session->call('snippet.get', $_->{'id'});
	if ($data->{username} !~ /^$user$/) {next};	# skip favorites (back up just your snippets)
	$snippets[$i]=$data;				# dump for post loop processing
	print "##### $data->{title}\n";
	print "##### $data->{comment}\n";
	print "##### $data->{language} $data->{tags}\n";
	print "##### $data->{source}\n";
	print "#####\n";
	print "#####\n";
}

@snippets = sort {$a->{language} cmp $b->{language}} @snippets;		# sort by language

#!/usr/bin/perl -w
use strict;
#
# List empty directories
# perl administration posix
#


# set start path

my $startpath = shift || '.';						


sub checkpath {
	my $path = shift;
	# open path or die
	opendir my($dir), $path	
		or die "Can't open $path : $!\n";				
	# debug
	#print "I am here: $path\n";
	# get directory content but skip . and .. (to avoid circular looping)
	my @content = grep {$_ !~ /^\.\.?$/} readdir $dir;
	# print directory name and exit if empty
	if (!@content) {
		print "$path\n";
		return;
	}
	# recurse trough directories
	foreach my $subpath (grep { -d "$path/$_"} @content) {
		checkpath($path.'/'.$subpath);
	}
}

checkpath($startpath);

use WWW::Selenium;
use Test::More tests => 2;  #update to reflect the number of tests to be run

my $sel = WWW::Selenium->new( host => "localhost", 
                              port => 4444, 
                              browser => "*iexplore",  # *iehta has more cross-domain privileges than *iexplore
                              browser_url => "http://mysite.com",
                            );
$sel->start();
$sel->open("http://mysite.com/testpopup.html");
diag("Check whether the popup is hidden.");
my $canSeePopup = $sel->is_visible("modalWindow");
ok ($canSeePopup == 0, "Popup is not visible.");
diag("Check whether the magic is hidden.");
ok(
   $sel->is_visible("modalWindowMagicLayer") == 0,
   "CSS magic is hidden... for now."
  );
$sel->stop();;

#!/usr/bin/perl -w
# To install the Flickr perl library on OSX with macports I do:
# sudo port install p5-flickr-api
# On Linux there's a similar package.
#
# Then to get Flickr::Photoset I do:
# sudo perl -MCPAN -e 'install Flickr::Photoset'


use Data::Dumper;
use Flickr::Photoset;
use Flickr::Photo;
use LWP::Simple;
use strict;

my $params = { api_key => 'your api key'};
my $info = {};

my $photoset = Flickr::Photoset->new($params);

# specify a photoset
if ($photoset->id({id => '72057594072478931'})) {
  my $title = $photoset->title;
  my $owner = $photoset->owner->real_name;
  my $photos = $photoset->photos;
  foreach my $p ( @$photos ) {
  my $id = $p->id;
  my $sizes = $p->sizes;
    foreach my $s (@$sizes) {
      if ( $s->{'label'} eq 'Original') {
        $info->{$id} = {
          source => $s->{'source'},
          title  => $p->title,
          server => $p->server
        };
        my $ret = getstore(
                    $s->{'source'},
                    $p->title.'_'.$id.'.jpg'
                  );
        print 'response was '.$ret.' for '.$p->title."/n";
      }
    }
  }
}