#!/usr/bin/perl

use warnings;
use strict;
use Net::Ping;
# use Module::Versions::Report;

my @pinglist = (
  'localhost',
  'www.google.com',
);

# my $p = Net::Ping->new('icmp', 5);
# my $p = Net::Ping->new('icmp', 5) or die "$!\n";
# my $p = Net::Ping->new('icmp', 5) or die "0+$!\n";
my $p = Net::Ping->new('icmp', 5) or die "$^E\n";

# for my $h (@pinglist) {
#   if ($p->ping($h, 5)) { print "(ok) $h"; }
#   else                 { print "<NO> $h"; }
#   print "\n";
# }

$p->close;


##</code><code>##

/* Nominal LarryWall Theme */
/* for use with Blue, Green, or Red themes */
body      {background-color:#e0ff00;}
A:link    {color:#0000ff; background-color:inherit}
A:visited {color:#800080; background-color:inherit}
A:active  {color:#ff0000; background-color:inherit}

##</code><code>##

# ~/.bash_profile
if [ -d ~/bin/Pmt ]; then
  export PM_USER=ybiC
  PATH="~/bin/Pmt:${PATH}"
fi



#!/bin/sh
# ~/bin/PmtMp
cd ~/bin/Pmt
reset
multipoll


#!/bin/sh
# ~/bin/Pmt/Ou
while [ 1 ]
  do
    clear
    date
    other_users
    sleep 120
  done


#!/bin/sh
# ~/bin/Pmt/Ssm
clear
shell send_msg


#!/bin/sh
# ~/bin/Pmt/Cb
clear
chatterbox -p 17

##</code><code>##

 #!/usr/bin/perl -w
use strict;
{
  my %sub;

  $sub{foo} = sub{
    whatever;
  };
  $sub{bar} = sub{
    whatever;
    whatever;
  };
  $sub{bat} = sub{
    whatever;
  };
  $sub{moo} = sub{
    whatever;
    whatever;
    whatever;
  };
}

##</code><code>##

#! /usr/bin/perl -w
# netsnmpt.pl

use strict;
use Net::SNMP(qw(snmp_event_loop oid_lex_sort));

my @targets = @ARGV;
my @oid = (
  '.1.3.6.1.2.1.2.2.1.1',
  '.1.3.6.1.2.1.31.1.1.1.1',
  '.1.3.6.1.2.1.2.2.1.7',
  '.1.3.6.1.2.1.2.2.1.8',
);
# ifIndex
# ifName
# ifAdminStatus
# ifOperStatus

my ($session, $error, $response);
for my $target(@targets) {
  ($session, $error) = Net::SNMP -> session(
    -hostname  => $target,
    -community => 'public',
  );

print($session -> hostname(), "\n");
  for my $oid(@oid) {
    if (defined($response = $session -> get_table($oid))) {
      for my $value(oid_lex_sort(keys(%{$response}))) {
        print($response -> {$value}, "\n");
      }
    } else {
      print($session -> error(), "\n");
    }
   }
}

##</code><code>##

package Cisco::Utils::Internal::DateTime;

$VERSION   = 0.02.00;
@EXPORT_OK = qw(DateTime);

use strict;
use base 'Exporter';

sub DateTime {
  my($sec,$min,$hour,$mday,$mon,$year) = localtime(time);

  my $datetime = sprintf(
    "%04d-%02d-%02d %02d:%02d:%02d",
    $year+1900,$mon+1,$mday,$hour,$min,$sec
  );
}

1;

=head1 NAME

DateTime

=head1 SYNOPSIS

DateTime is intended for use by Cisco::Utils modules.  It's not
meant for use directly from Perl scripts, and it's interface may change
at any time without notice.

DateTime accepts no arguments, and returns a scalar containing
year, month, mday, hour, minute, second in human-readable format.
YYYY-MM-DD hh:mm:ss

 #!/usr/bin/perl -w

 use strict;
 use Cisco::Utils::Internal::DateTime qw(DateTime);

 my $datetime = DateTime() or die "Error: $!";
 print "$datetime\n";

=head1 UPDATE

2001-11-18  07:40 CDT
  Original working code.

=head1 TODO

Figure out enough h2xs to package this module for distribution.

=head1 BUGS

None that I know of.

=head1 REQUIRES

Nothing aside from Perl itself.

=head1 AUTHOR

ybiC

=head1 CREDITS

Thanks to Petruchio for kickstarting me into modulitazing my Ciscoey
scripts.  And to vroom for PerlMonks.

=cut


##</code><code>##

package Cisco::Utils::Internal::GetFromUser;

$VERSION = 0.05.20;
@EXPORT  = qw(GetFromUser);

use strict;
use base 'Exporter';
use Term::ReadKey;
use Term::ReadLine;

sub GetFromUser {
  my $echo    = shift(@_);
  my $timeout = shift(@_);
  my @prompt  = @_;
  my $pass;

  $echo    = 0  unless $echo == 1; 
  $timeout = 60 unless(($timeout =~ /\d+/) and ($timeout >= 1));
  @prompt  = '' unless defined @prompt;

  ReadMode('noecho') if $echo == 0;
  print $_ for @prompt;

  if ($^O eq 'MSWin32') { chomp ($pass = <STDIN>); }
  else { $pass = ReadLine($timeout); }

  ReadMode('restore') if $echo == 0;
  unless(defined($pass)) {
    return 'Sorry, you waited too long to enter something.';
  }
  chomp $pass;
  return $pass;

}

1;

=head1 NAME

GetFromUser

=head1 SYNOPSIS

GetFromUser is intended for use by Cisco::Utils modules.  It's not
meant for use directly from Perl scripts, and it's interface may change
at any time without notice.

GetFromUser accepts 2 scalars and 1 array for input values:

 1 - echo-to-screen:  1 for yes, 0 for no (default of no)
 2 - timeout seconds: integer greater than zero (default of 60)
 3 - prompt:          text to prompt user to provide input (default of '')

User prompt is here so echo disabled *before* user is prompted for input.

Term::ReadKey provides no-echo while user typing password.
Term::ReadLine provides timeout if wait too long.

Win32 doesn't support timeout, 2nd arg still required before prompt text.

 #!/usr/bin/perl -w

 use strict;
 use Cisco::Utils::Internal::GetFromUser;

 my $echo    = 0;
 my $timeout = 120;

 my $favColor = GetFromUser(
   $echo,
   $timeout,
   "\nThe old man at the ropebridge asks\n",
   'Wots yer favorite color? ',
 );
 if $favColor eq 'Sorry, you waited too long to enter something.' {
   print "\nWooooaaahh!!\n\n"
 } else { 
   print "\n$favColor, eh?  You may pass.\n\n";
 }

=head1 UPDATE

2001-11-18  22:20 CDT
  Original working code.

=head1 TODO

 Investigate Term::Prompt for cross-platform no-echo.
 Figure out enough h2xs to package this module for distribution.

=head1 BUGS

None that I know of.

=head1 REQUIRES

 Term::ReadKey
 Term::ReadLine

=head1 AUTHOR

ybiC

=head1 CREDITS

Thanks to Petruchio for kickstarting me into modulitazing my Ciscoey
scripts.  And to vroom for PerlMonks.

=cut


##</code><code>##

package Cisco::Utils::Internal::PrintLogConsole;

$VERSION   = 0.02.09;
@EXPORT_OK = qw(PrintLogConsole);

use strict;
use base 'Exporter';

sub PrintLogConsole { 
  my ($file, $aRefMssgItems) = @_;

  open(FH, "> $file") or return "Error opening $file: $!\n";

  for(@$aRefMssgItems){
    print "$_\n";
    print(FH "$_\n") or return "Error printing to $file: $!\n";
  }

  close FH or return "Error closing $file: $!\n";
}

1;


=head1 NAME

PrintLogConsole

=head1 SYNOPSIS

PrintLogConsole is intended for use by Cisco::Utils modules.  It's not
meant for use directly from Perl scripts, and it's interface may change
at any time without notice.

PrintLogConsole accepts a list of two elements.  The first is a scalar
of the file to print to.  The second is an array reference of the
message(s) to print.

 #!/usr/bin/perl -w

 use strict;
 use Cisco::Utils::Internal::PrintLogConsole qw(PrintLogConsole);

 my $logfile = './file.log';
 my @msgs = (
   "Starting program run",
   "La-la-la...",
   "Humina humina...",
 );
 my $response = PrintLogConsole($logfile, \@msgs);
 unless ($response = 1) {
   print $response;
   exit;
 }

=head1 UPDATE

2001-11-17  22:25 CDT
  Original working code.

=head1 TODO

Figure out enough h2xs to package this module for distribution.

=head1 BUGS

None that I know of.

=head1 REQUIRES

Nothing aside from Perl.

=head1 AUTHOR

ybiC

=head1 CREDITS

Thanks to Petruchio for kickstarting me into modulitazing my Ciscoey
scripts.  And to jcwren for scalar+array passing tips.  And to vroom
for PerlMonks.

=cut


##</code><code>##

package Cisco::Utils::Internal::Unique;

$VERSION   = 0.15.02;
@EXPORT_OK = qw(Unique);

use strict;
use base 'Exporter';
use Tie::IxHash;

sub Unique {
  my @inlist = @_;
  my (@uniq, %seen);

  my $have_TIxH;
  BEGIN {
    $have_TIxH = 0;
    eval { require Tie::IxHash };
    unless ($@) {
      Tie::IxHash->import();
      $have_TIxH = 1;
    }
  }

  tie (%seen, "Tie::IxHash") if ($have_TIxH == 1);
  ++$seen{$_} for(@inlist);
  @uniq = keys %seen;
}

1;

=head1 NAME

Unique

=head1 SYNOPSIS

Unique is intended for use by Cisco::Utils modules.  It's not
meant for use directly from Perl scripts, and it's interface may change
at any time without notice.

Unique accepts a list, and returns a list containing only the unique
elements.  If Tie::IxHash is installed, the return elements are in the
same order as the list input.  If not, the order of the returned list
elements are subject to Perl's unpredictable hash element ordering.

 #!/usr/bin/perl -w

 use strict;
 use Cisco::Utils::Internal::Unique qw(Unique);

 my $file = shift or die "You forgot to provide a filename!\n";
 open (FH, "< $file") or die "Error opening $file for read: $!";
 my @lines = <FH>;
 close FH             or die "Error closing $file: $!";

 my @uniques  = Unique(@lines) or die "Error: $!";
 print "$_" for @uniques;

=head1 UPDATE

2001-11-17  19:15CDT


=head1 TODO

Check for presence of Tie::IxHash before tieing %seen.

=head1 BUGS

None that I know of.

=head1 REQUIRES

Tie::IxHash

=head1 AUTHOR

ybiC


=head1 CREDITS

Thanks to Petruchio for kickstarting me into modulatizing my Ciscoey
scripts.  And to vroom for PerlMonks.

=cut