#!/usr/bin/perl -w

use Net::IRC;
use strict;

my $irc = new Net::IRC;

my $conn = $irc->newconn(    

    Server         => shift || 'irc.azzurra.org',        
    Port        => shift || '6667',     
    Nick        => 'Iper_',    
    Ircname        => 'Only an IRC roBOT',    
    Username    => 'Mr. Iper');
    $conn->{channel} = shift || '#prova' or die "Error: connection ref
+used\n";


my @sentences = (

"Grembiule nero e fiocco azzurro: per un bambino milanista il 1^ giorn
+o di scuola è un trauma!",
"Sai cos'è che odio nel primo giorno di scuola? Che è troppo lontano d
+all'ultimo!",
"Ho l'orologio che va avanti di 3 ore, ma non sono mai riuscito ad agg
+iustarlo. Così da New York mi sono trasferito a Los Angeles!",
"Se la conoscenza non viene messa in azione è peggio dell'ignoranza...
+",
"Il significato di un uomo non va ricercato in ciò che egli raggiunge,
+ ma in ciò che vorrebbe raggiungere.",
"Possiamo essere grandi solo quanto le nostre occasioni.",
"Carpe diem!",
"I giovani cercano l'impossibile e , generazione dopo generazione, lo 
+conseguono.",
"Quando il gioco si fa duro, i duri entrano in gioco.",
"Ci sono due modi per uscire da questo edificio, il primo e' passando 
+per il tetto usando il pontile, il secondo e' in stato di arresto ...
+ corri comunque un rischio sta a te decidere",
"Ti ho mostrato la soglia, ora tocca a te attraversarla...",
"What God taxi driver! - Che Dio t'assista!",
"I tre anni più duri per Totti? Quelli della prima elementare!",
"Totti: la fidanzata gli ha regalato un libro. Lui lo apre e legge: <<
+Sommario... Piacere, so' Francesco!>>.",
"L'unico modo per non far conoscere agli altri i propri limiti, è di n
+on oltrepassarli mai.",
"Niente è impossibile: l'impossibile è solo poco più difficile del pos
+sibile...",
"E' ricercando l'impossibile che l'uomo ha sempre realizzato il possib
+ile. Coloro che si sono saggiamente limitati a cio' che appariva loro
+ come possibile, non hanno mai avanzato di un solo passo. - Michail B
+akunin (1814 - 1876)",
"But make me the pleasure! - Ma fammi il piacere!",
"But of what! - Ma di che!",
"I'm tired dead! - Sono stanco morto!",
"L'eterno mistero del mondo è la sua comprensibilità",
"Cogito ergo sum",
"Ratio in medio stat",
"Fatti non foste viver come bruti ma per seguir virtute e canoscenza",
"How many people can read hex if only you and dead people can read it?
+",
"There are only 10 types of peole in the world, those who understand b
+inary and those who don't",
"If one fights me than he will become zero, I am the only one in a cro
+ud of zeroes. - AndreaGeddon (9000 (sta troppo avanti!) - +infinito (
+ed oltre!) )",

);


sub on_connect {

    my $conn = shift;
    $conn->join($conn->{channel});
    $conn->privmsg($conn->{channel}, "Ladies and gentlemen, giulia_1 i
+s here!");
    $conn->{connected} = 1;
}

sub on_join {

    my ($conn, $event) = @_;
    my $nick = $event->{nick};
    if($nick ne 'Iper_') {($conn->privmsg($conn->{channel}, "Hi, $nick
+!"));}
}    

sub on_invite {

    my ($conn, $event) = @_;
    my $nick = $event->{nick};
    $conn->privmsg($nick, "$nick, tnx for inviting me on your chan but
+ now I'm very busy. See you later.");
}

sub on_part {

    my ($conn, $event) = @_;
    my $nick = $event->{nick};
    $conn->privmsg($conn->{channel}, "Bye, $nick!");
}

   

sub on_ping {

    my ($conn, $event) = @_;
    my $nick = $event->nick;
    $conn->ctcp_reply($nick, join (' ', ($event->args)));
    print "*** CTCP PING request from $nick received\n";
}

sub on_version {

    my ($conn, $event) = @_;
    my $nick = $event->nick;
    my $reply = "VERSION Binary os, Binary client, Athlon xp +infinite
+";
    $conn->ctcp_reply($nick, $reply);
    print "*** CTCP VERSION request from $nick received\n";
}

sub on_source {

    my ($conn, $event) = @_;
    my $nick = $event->nick;
    my $reply = "SOURCE ./query giulia_1 (or giulia_0 if she's away) o
+r type !source";
    $conn->ctcp_reply($nick, $reply);
    print "*** CTCP SOURCE request from $nick received\n";
}

sub on_dcc {

    my ($conn, $event) = @_;
    my $nick = $event->nick;
    my $reply = "DCC no dcc, tnx";
    $conn->ctcp_reply($nick, $reply);
    $conn->privmsg($nick, "Hi $nick, I'm sorry but my client doesn't s
+upport dcc.");
    print "*** CTCP DCC request from $nick received\n";
}

sub on_msg {

    my ($conn, $event) = @_;
        my $nick = $event->nick;
        my $text = $event->{args}[0];

     if ($text =~ /^\!(.+)$/) {

        if ($text =~ "source") {
        $conn->privmsg($nick, "$nick, I'm sending to you my source cod
+e ");
        $conn->schedule(10, \&Net::IRC::Connection::new_send, $nick, "
+iper.pl");
        print "*** Iper's source has been requested by $nick \n";}

        if ($text =~ "hi"){
        $conn->privmsg($nick, "Hi, $nick!");}

        if ($text =~ "quote"){
        $conn->privmsg($nick, &rand());}
      
        if ($text =~ "about"){
        $conn->privmsg($nick, "Internet Perl Eccentric Robot, a Giulia
+'s project ==> Mr. Iper r0x! published on perlmonks.org");}

        if ($text =~ "help") {

        $conn->privmsg($nick, "My commands are: !hi, !quote, !about !s
+ource, !zena (on msg) or !quote, !go_out and !source (on public). I a
+lso say <<Hi, nick!>> or <<Bye, nick!>> (on join & on part), I reply 
+to ping, version, source, dcc and invite. If the language  used is ba
+d I say <<Nick, moderate the language plese>> and before exiting I sa
+ys <<Bye...>> to the channel ...I'm a great bot :)");}

        if ($text =~ "zena") {

        $conn->privmsg($conn->{channel}, chr(3)."12,4FORZA".chr(3)."4,
+12GENOA"); }

                              }        

        else {

        $conn->privmsg($event->{nick}, "Don't anybody /msg IperBot in 
+this way, contact giulia_1 for more informations or type !help for th
+e  commands' list");

            }

}

sub on_public {

    my ($conn, $event) = @_;
        my $nick = $event->nick;
        my $text = $event->{args}[0];
        my ($arg) = ($event->args);

     if ($text =~ /^\!(.+)$/) {

        if ($text =~ "source") {
        $conn->privmsg($nick, "$nick, I'm sending to you my source cod
+e ");
        $conn->schedule(10, \&Net::IRC::Connection::new_send, $nick, "
+iper.pl");
        print "*** Iper's source has been requested by $nick \n";}

        if ($text =~ "go_out") {
    $conn->privmsg($conn->{channel}, "Ok, $nick, I'm only a bot");
    $conn->quit("Quitted by $nick");
    exit 0;}

        if ($text =~ "quote"){
        $conn->privmsg($conn->{channel}, &rand());}

                             }

        if ($arg =~ /azz/i){
    
        $conn->privmsg($conn->{channel}, "$nick, moderate the language
+ please!");

        }

   
              }

sub on_leaving {

    my ($conn, $event) = @_;
    $conn->privmsg($conn->{channel}, "Bye all! => RETN => C3 => 110000
+11");
}        

sub rand {

       return $sentences[ rand scalar @sentences ];
}


$conn->add_handler('join', \&on_join);
$conn->add_handler('invite', \&on_invite);
$conn->add_handler('part', \&on_part);
$conn->add_handler('cping', \&on_ping);
$conn->add_handler('cversion', \&on_version);
$conn->add_handler('csource', \&on_source);
$conn->add_handler('cdcc', \&on_dcc);
$conn->add_handler('msg',    \&on_msg);
$conn->add_handler('public', \&on_public);
$conn->add_handler('leaving', \&on_leaving);
$conn->add_handler('376', \&on_connect);

$irc->start();


# iper ==> Internet Perl Eccentric Robot coded by giulia_1\0 (giulia@o
+lografix.org)

#!/usr/bin/perl -w
# rtfm - read the friendly manual/s
#
# Usage: rtfm [number of man pages to read]
#
# Originally written by Daniel N. Andersen, June 2004
# Modified by just about everyone at perlmonks.org

use strict;

my $lines = 0;
my $loop  = 1;
my $select;

if($ARGV[0])
{
    $loop = $ARGV[0] unless($ARGV[0] =~ /\D/);
}

while($loop)
{
    foreach my $path (split(/:/, $ENV{'PATH'}))
    {
        opendir(PATH, $path);
        while(defined($_ = readdir(PATH)))
        {
            if(-f "$path/$_")
            {
                $lines++;
                $select = $_ if int(rand($lines)) == 0;
            }
        }
        closedir(PATH);
    }
    system(man => $select);
    $lines = 0;
    $loop--;
}

#!/usr/bin/perl -w
# pocketgopher - an RFC-1436 compliant gopher server in < 1024B
# Beth Skwarecki 2004
# This program is free software under the GNU GPL
use strict;
use IO::Socket;
local $/ = "\015\012";

#### CONFIGURATION
my $port = '7070';
my $root = '/home/beth/gopher/gopher';
#### THAT IS ALL

chroot $root or die "can't chroot: $!\n";

# fork
local $SIG{HUP} = 'IGNORE';
exit if (my $pid = fork); 


# listen
my $sock = new IO::Socket::INET
(LocalPort => $port,
 Type => SOCK_STREAM,
 Listen => 1,
 Reuse => 1
) or die "Couldn't create socket: $!\n";


# serve
my $s = $sock->accept();
while(my $req = <$s>){

  chomp (my $req = shift);
  $req = '/'.$req;

  &error unless (-r $req);
  $req .= '/.cache' if ( -d _ );
  printfile($req);
  close($sock);
}


sub printfile {
  open (FILE, shift);
  binmode FILE;
  print $s <FILE>;
  close FILE;
}

sub error {
    my $req = shift;
  print $s "iBad Request: $! \tfake\t(NULL)\t0".$/;
}


----------------------------
(code is over, notes follow)

2004-05-12: 
- changed $/ to \015\012 (thanks revdiablo)
- did a binmode() on the filehandle (thanks Corion)

These changes improve things to serve gopher clients on 
different platforms; however, the code still assumes that 
the server is running on a unix-oid OS.

#!/usr/bin/perl
#hint, call it "google", try "google perl monks"
#@browser=qw(/usr/bin/lynx -nopause -accept_all_cookies);
@browser=qw(/usr/local/bin/elinks);
$q=join'',map{sprintf"%%%.2X",$_}unpack"C*","@ARGV"and$q="&q=$q";
exec@browser,"http://www.google.com/search?num=100$q";

#!/usr/bin/perl -w

use strict;
use Bio::DB::GenBank;
use Bio::SeqIO;
use File::Basename;

# configuration information
my $outfile  = 'outfile';
my $progname = basename $0;

# usage information
my $usage = "usage:  $0 accession1 [accession2 ...]\n";
die $usage unless @ARGV;

# start program flow
my $gb = new Bio::DB::GenBank( 
   -retrievaltype => 'tempfile', 
   -format => 'Fasta'
);

my $seqout = Bio::SeqIO->new( -file => ">$outfile", -format => 'FASTA'
+ );

my $seqio = $gb->get_Stream_by_acc( @ARGV );
while( my $sequence =  $seqio->next_seq ) {
   $seqout->write_seq($sequence);
}

#!/usr/bin/perl
use strict;
use warnings;

print graph( @{[1..96]} );

######################################################################
+#
### give me an array of 96 integers that represent each of the
### 15-minute intervals in 24 hours.  I'll give you an ascii graph
### (of, e.g., concurrent users?)
sub graph {
  my( $i, $magic, $m, $p, $top, @g ) = ( 0, 20, 7, 96, 0, () );
  for (0..$p-1) { $top = $top > $_[$_] ? $top : $_[$_] }
  my $s = $top > $magic ? ( $top / $magic ) : 1;  ### calculate scale
  for (0..$magic) {
    $g[$_] = sprintf("%".($m-1)."d ",$_*$s) . ($_%5==0?'_':'.') x $p;
    for $i (0..$p-1) { substr($g[$_],$i+$m,1) = '|' if $_[$i]/$s>$_ } 
+}
  join( "\n", reverse( @g ), ' Time: ' . '|^^^' x ( $p / 4 ),
    ' ' x $m . "12am 1am 2am 3am 4am 5am 6am 7am 8am 9a 10a 11a " .
    "12pm 1pm 2pm 3pm 4pm 5pm 6pm 7pm 8pm 9p 10p 11pm" );
}  # end sub graph

__END__
    96 _______________________________________________________________
+_________________________________
    91 ...............................................................
+............................|||||
    86 ...............................................................
+.......................||||||||||
    81 ...............................................................
+..................|||||||||||||||
    76 ...............................................................
+.............||||||||||||||||||||
    72 _______________________________________________________________
+_________||||||||||||||||||||||||
    67 ...............................................................
+....|||||||||||||||||||||||||||||
    62 ..............................................................|
+|||||||||||||||||||||||||||||||||
    57 .........................................................||||||
+|||||||||||||||||||||||||||||||||
    52 ....................................................|||||||||||
+|||||||||||||||||||||||||||||||||
    48 ________________________________________________|||||||||||||||
+|||||||||||||||||||||||||||||||||
    43 ...........................................||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    38 ......................................|||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    33 .................................||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    28 ............................|||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    24 ________________________|||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    19 ...................||||||||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
    14 ..............|||||||||||||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
     9 .........||||||||||||||||||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
     4 ....|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
     0 |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+|||||||||||||||||||||||||||||||||
 Time: |^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^
+^|^^^|^^^|^^^|^^^|^^^|^^^|^^^|^^^
       12am 1am 2am 3am 4am 5am 6am 7am 8am 9a 10a 11a 12pm 1pm 2pm 3p
+m 4pm 5pm 6pm 7pm 8pm 9p 10p 11pm

# deprecated - pragmatic module to mark a package or a sub as unsuppor
+ted

package deprecated;

=head1 NAME

deprecated - pragmatic module to mark a package or a sub as unsupporte
+d

=head1 SYNOPSIS

    package OldeCrufte;
    use deprecated qw(do_hack);  # calling OldeCrufte::do_hack() will 
+carp

    package OldeCrufte;
    use deprecated;              # using the OldeCrufte module will ca
+rp

=head1 DESCRIPTION

The word 'deprecated' is used to describe something that has lost supp
+ort
or is otherwise not recommended.  In programming, this usually means t
+hat
a newer, faster, safer or more supportable method has replaced an earl
+ier
routine.

When added to a package, this pragma will mark the package, or select
subs within it, as being deprecated.  It does not change the behavior 
+of
the subs within the package, except that on the first call of the sub,
+ a
helpful message is printed to the C<STDERR> stream before running.

The runtime messages are suppressed if the PERLLIB environment variabl
+e
does not contain the words 'home', 'devel', or 'test'.
This way, only developers see these messages when working with
the programs, but normal end-users do not see them.  This
test is easy to customize for other company library
situations.

=cut

use strict;

sub debug
{
    return (defined $ENV{PERLLIB} and
        $ENV{PERLLIB} =~ /home|devel|test/i);
}

use constant EVAL_CODE => <<'END_CODE';
sub %s::INIT
{
    my $overridden = \&%s;
    *%s =
    sub
    {
        if (deprecated::debug())
        {
        require Carp;
        Carp::carp('%s() is deprecated; ' .
               'see the documentation for an alternative;');
        }
        *%s = $overridden;
        goto &$overridden;
    };
}
END_CODE

sub import {
    my $class = shift;
    my $pkg = caller;
    if (not @_ and debug())
    {
    require Carp;
    Carp::carp("Module $pkg is deprecated; " .
           'see the documentation for an alternative;');
    }
    eval join('', map { sprintf(EVAL_CODE, $pkg, ("$pkg\::$_") x 4) } 
+@_);
}

1;

__END__

=head1 AUTHORS

Proposed and tested by Ed Halley <F<ed@halley.cc>>, and draft
implementation by 'Aristotle', as posted on F<http://www.perlmonks.org
+/>
in 2003.

=cut

#   Howdy! This is my very first Perl script! I know it's kinda short
#   but any response would be great. What I am trying to do next is to
+ make 
#   it in a CGI/HTML format to put on a web page. Hints anyone?



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

print "Guess the number.";
print "DIRECTIONS:\nGuess a number between 1 and 100 inclusive.\n\n";
$random = int(rand(100)+1);      # I added 1 to the random
                                 # number generator to push the
                                 # possible numbers from 0-99 to 1-100

for ($try=6;$try>0;$try--){      # $try is the number of tries you get
+ (DUH!)
    print "You have 1 try left. Use it wisely!\n\n" if($try ==1);
    print "You have $try tries left.\n\n" if($try !=1);
    print "What is your guess? -->";
    do {
        $guess = <STDIN>; chomp $guess;

     }while (!$guess);
    print "HA! HA! too HIGH.\n" if ($guess>$random);
    print "OH! NO! too LOW.\n" if ($guess<$random);
    if ($guess==$random){
        print "'Bout time you guessed it.   Stupid head.\n\n" ;
        exit;
    }
}
print "The answer was $random. And so is your IQ.\n\n\nSTUPID!!\n\n";
exit;


############################################################
#           UPDATED --- 1/11/03                            #
#  NOTE: the problem with this is that it loops            #
#  printing the button text box ect. w/o giving you a      #
#  chance to guess. Still a work in progress.              #
#  Any generous monk out there willing to give me a        #
#  little nudge?                                           #
############################################################



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

print "Content-type: text/html\n\n";
use CGI;
$query = new CGI;
print "<HTML><HEAD><title>Guess the number.</title></HEAD><BODY>";
print "<H1>DIRECTIONS:\nGuess a number between 1 and 100 inclusive.\n\
+n</H1>";
$random = int(rand(100)+1);

for ($try=6;$try>0;$try--){
    print "You have 1 try left. Use it wisely!\n\n" if($try ==1);
    print "You have $try tries left.\n\n" if($try !=1);
    print "What is your guess? -->";
    print '<INPUT TYPE="text" NAME="guess">';
    print '<INPUT TYPE = "submit">';
    print "HA! HA! too HIGH.\n" if ($guess>$random);
    print "OH! NO! too LOW.\n" if ($guess<$random);
    if ($guess==$random){
        print "'Bout time you guessed it.   Stupid head.\n\n" ;
        print"</BODY>";
        exit;
#         print "The answer was $random. And so is your IQ.\n\n\nSTUPI
+D!!\n\n";exit;
    }
}
print "The answer was $random. And so is your IQ.\n\n\nSTUPID!!\n\n";
print"</BODY>";
exit;

#
# Copies MP3s by genre tag using sources directory tree.
# Script must be executed from the source's root
# i.e. $srcdir must be a path on the same drive as where the script is
+ executed from
#
# Criticism/advice appreciated
# 

use strict;
use MP3::Info;
use File::Find;
use File::Copy;
use File::Basename;
use File::Path;

my $genre = 'Country';
my $srcdir = '/MP3 Test/';
my $dstdir = 'c:/';
my ($tag, $newdir, $path, $file, $dir);

find(\&wanted, $srcdir);

sub wanted {
    open(FL, $File::Find::name);

if ((/\.mp3/)){
    $tag = get_mp3tag($_) or print "Could not access tag on $_\n" and 
+next;

    if ($tag->{"GENRE"} eq $genre) {
        $path = $File::Find::name;
        $dir = dirname($path);
        $file = basename($path);
        $newdir = $dstdir . $dir;

        if (! -d $newdir ) { 
            mkpath ($newdir, 0666) || die "can't mkdir $newdir: $!\n";
        }
        copy($path, $newdir . '/' . $file) or die "copy failed: $!\n";
+ 
    }
}
    close(FL);
}

#!/usr/bin/perl -w
# As our unix printer setup is weird and I sometimes want to
# print to networked (HP) printers, I needed something like
# netcat. I was unsatisfied with <tt>telnet</tt>, as it did
# output stuff I didn't want, and I didn't want to add the
# redirection to /dev/null. Perl to the rescue:

use strict;
use IO::Socket;

select IO::Socket::INET->new(PeerAddr => shift, PeerPort => (shift || 
+23));
print
  for <>;

__END__
# or, as a oneliner:
perl -MIO::Socket -pe 'BEGIN{select IO::Socket::INET->new(PeerAddr=>sh
+ift,PeerPort =>(shift||23))}'