#----------------------------- package Alpha; $name = "first"; package Omega; $name = "last"; package main; print "Alpha is $Alpha::name, Omega is $Omega::name.\n"; Alpha is first, Omega is last. #----------------------------- require "FileHandle.pm"; # run-time load require FileHandle; # ".pm" assumed; same as previous use FileHandle; # compile-time load require "Cards/Poker.pm"; # run-time load require Cards::Poker; # ".pm" assumed; same as previous use Cards::Poker; # compile-time load #----------------------------- 1 package Cards::Poker; 2 use Exporter; 3 @ISA = ('Exporter'); 4 @EXPORT = qw(&shuffle @card_deck); 5 @card_deck = (); # initialize package global 6 sub shuffle { } # fill-in definition later 7 1; # don't forget this #----------------------------- |
#----------------------------- package YourModule; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); use Exporter; $VERSION = 1.00; # Or higher @ISA = qw(Exporter); @EXPORT = qw(...); # Symbols to autoexport (:DEFAULT tag) @EXPORT_OK = qw(...); # Symbols to export on request %EXPORT_TAGS = ( # Define names for sets of symbols TAG1 => [...], TAG2 => [...], ... ); ######################## # your code goes here ######################## 1; # this should be your last line #----------------------------- use YourModule; # Import default symbols into my package. use YourModule qw(...); # Import listed symbols into my package. use YourModule (); # Do not import any symbols use YourModule qw(:TAG1); # Import whole tag set #----------------------------- @EXPORT = qw(&F1 &F2 @List); @EXPORT = qw( F1 F2 @List); # same thing #----------------------------- @EXPORT_OK = qw(Op_Func %Table); #----------------------------- use YourModule qw(Op_Func %Table F1); #----------------------------- use YourModule qw(:DEFAULT %Table); #----------------------------- %EXPORT_TAGS = ( Functions => [ qw(F1 F2 Op_Func) ], Variables => [ qw(@List %Table) ], ); #----------------------------- use YourModule qw(:Functions %Table); #----------------------------- @{ $YourModule::EXPORT_TAGS{Functions} } , #----------------------------- |
#----------------------------- # no import BEGIN { unless (eval "require $mod") { warn "couldn't load $mod: $@"; } } # imports into current package BEGIN { unless (eval "use $mod") { warn "couldn't load $mod: $@"; } } #----------------------------- BEGIN { my($found, @DBs, $mod); $found = 0; @DBs = qw(Giant::Eenie Giant::Meanie Mouse::Mynie Moe); for $mod (@DBs) { if (eval "require $mod") { $mod-> import (); # if needed $found = 1; last; } } die "None of @DBs loaded" unless $found; } #----------------------------- |
#----------------------------- BEGIN { unless (@ARGV == 2 && (2 == grep {/^\d+$/} @ARGV)) { die "usage: $0 num1 num2\n"; } } use Some::Module; use More::Modules; #----------------------------- if ($opt_b) { require Math::BigInt; } #----------------------------- use Fcntl qw(O_EXCL O_CREAT O_RDWR); #----------------------------- require Fcntl; Fcntl->import(qw(O_EXCL O_CREAT O_RDWR)); #----------------------------- sub load_module { require $_[0]; #WRONG import $_[0]; #WRONG } #----------------------------- load_module('Fcntl', qw(O_EXCL O_CREAT O_RDWR)); sub load_module { eval "require $_[0]"; die if $@; $_[0]->import(@_[1 .. $#_]); } #----------------------------- use autouse Fcntl => qw( O_EXCL() O_CREAT() O_RDWR() ); #----------------------------- |
#----------------------------- package Alpha; my $aa = 10; $x = "azure"; package Beta; my $bb = 20; $x = "blue"; package main; print "$aa, $bb, $x, $Alpha::x, $Beta::x\n"; 10, 20, , azure, blue #----------------------------- # Flipper.pm package Flipper; use strict; require Exporter; use vars qw(@ISA @EXPORT $VERSION); @ISA = qw(Exporter); @EXPORT = qw(flip_words flip_boundary); $VERSION = 1.0; my $Separatrix = ' '; # default to blank; must precede functions sub flip_boundary { my $prev_sep = $Separatrix; if (@_) { $Separatrix = $_[0] } return $prev_sep; } sub flip_words { my $line = $_[0]; my @words = split($Separatrix, $line); return join($Separatrix, reverse @words); } 1; #----------------------------- |
#----------------------------- $this_pack = __PACKAGE__; #----------------------------- $that_pack = caller(); #----------------------------- print "I am in package __PACKAGE__\n"; # WRONG! I am in package __PACKAGE__ #----------------------------- package Alpha; runit('$line = <TEMP>'); package Beta; sub runit { my $codestr = shift; eval $codestr; die if $@; } #----------------------------- package Beta; sub runit { my $codestr = shift; my $hispack = caller; eval "package $hispack; $codestr"; die if $@; } #----------------------------- package Alpha; runit( sub { $line = <TEMP> } ); package Beta; sub runit { my $coderef = shift; &$coderef(); } #----------------------------- open (FH, "< /etc/termcap") or die "can't open /etc/termcap: $!"; ($a, $b, $c) = nreadline(3, 'FH'); use Symbol (); use Carp; sub nreadline { my ($count, $handle) = @_; my(@retlist,$line); croak "count must be > 0" unless $count > 0; $handle = Symbol::qualify($handle, ( caller() )[0]); croak "need open filehandle" unless defined fileno($handle); push(@retlist, $line) while defined($line = <$handle>) && $count--; return @retlist; } #----------------------------- |
#----------------------------- $Logfile = "/tmp/mylog" unless defined $Logfile; open(LF, ">>$Logfile") or die "can't append to $Logfile: $!"; select(((select(LF), $|=1))[0]); # unbuffer LF logmsg("startup"); sub logmsg { my $now = scalar gmtime; print LF "$0 $$ $now: @_\n" or die "write to $Logfile failed: $!"; } END { logmsg("shutdown"); close(LF) or die "close $Logfile failed: $!"; } #----------------------------- use sigtrap qw(die normal-signals error-signals); #----------------------------- |
#----------------------------- #% perl -e 'for (@INC) { printf "%d %s\n", $i++, $_ }' #0 /usr/local/perl/lib/i686-linux/5.004 # #1 /usr/local/perl/lib # #2 /usr/local/perl/lib/site_perl/i686-linux # #3 /usr/local/perl/lib/site_perl # #4 . #----------------------------- # syntax for sh, bash, ksh, or zsh #$ export PERL5LIB=$HOME/perllib # syntax for csh or tcsh #% setenv PERL5LIB ~/perllib #----------------------------- use lib "/projects/spectre/lib"; #----------------------------- use FindBin; use lib $FindBin::Bin; #----------------------------- use FindBin qw($Bin); use lib "$Bin/../lib"; #----------------------------- |
#----------------------------- #% h2xs -XA -n Planets #% h2xs -XA -n Astronomy::Orbits #----------------------------- package Astronomy::Orbits; #----------------------------- require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader); #----------------------------- require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); #----------------------------- #% make dist #----------------------------- |
#----------------------------- require Exporter; require SelfLoader; @ISA = qw(Exporter SelfLoader); # # other initialization or declarations here # #__DATA__ #sub abc { .... } #sub def { .... } #----------------------------- |
#----------------------------- #% h2xs -Xn Sample #% cd Sample #% perl Makefile.PL LIB=~/perllib #% (edit Sample.pm) #% make install #----------------------------- |
#----------------------------- package FineTime; use strict; require Exporter; use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(time); sub time() { ..... } # TBA #----------------------------- use FineTime qw(time); $start = time(); 1 while print time() - $start, "\n"; #----------------------------- |
#----------------------------- sub even_only { my $n = shift; die "$n is not even" if $n & 1; # one way to test #.... } #----------------------------- use Carp; sub even_only { my $n = shift; croak "$n is not even" if $n % 2; # here's another #.... } #----------------------------- use Carp; sub even_only { my $n = shift; if ($n & 1) { # test whether odd number carp "$n is not even, continuing"; ++$n; } #.... } #----------------------------- carp "$n is not even, continuing" if $^W; #----------------------------- |
#----------------------------- { no strict 'refs'; $val = ${ $packname . "::" . $varname }; @vals = @{ $packname . "::" . $aryname }; &{ $packname . "::" . $funcname }("args"); ($packname . "::" . $funcname) -> ("args"); } #----------------------------- eval "package $packname; \$'$val = \$$varname"; # set $main'val die if $@; #----------------------------- printf "log2 of 100 is %.2f\n", log2(100); printf "log10 of 100 is %.2f\n", log10(100); #----------------------------- $packname = 'main'; for ($i = 2; $i < 1000; $i++) { $logN = log($i); eval "sub ${packname}::log$i { log(shift) / $logN }"; die if $@; } #----------------------------- $packname = 'main'; for ($i = 2; $i < 1000; $i++) { my $logN = log($i); no strict 'refs'; *{"${packname}::log$i"} = sub { log(shift) / $logN }; } #----------------------------- *blue = \&Colors::blue; *main::blue = \&Colors::azure; #----------------------------- |
#----------------------------- #Can't locate sys/syscall.ph in @INC (did you run h2ph?) # #(@INC contains: /usr/lib/perl5/i686-linux/5.00404 /usr/lib/perl5 # #/usr/lib/perl5/site_perl/i686-linux /usr/lib/perl5/site_perl .) # #at some_program line 7. #----------------------------- #% cd /usr/include; h2ph sys/syscall.h #----------------------------- #% cd /usr/include; h2ph *.h */*.h #----------------------------- #% cd /usr/include; find . -name '*.h' -print | xargs h2ph #----------------------------- # file FineTime.pm package main; require 'sys/syscall.ph'; die "No SYS_gettimeofday in sys/syscall.ph" unless defined &SYS_gettimeofday; package FineTime; use strict; require Exporter; use vars qw(@ISA @EXPORT_OK); @ISA = qw(Exporter); @EXPORT_OK = qw(time); sub time() { my $tv = pack("LL", ()); # presize buffer to two longs syscall(&main::SYS_gettimeofday, $tv, undef) >= 0 or die "gettimeofday: $!"; my($seconds, $microseconds) = unpack("LL", $tv); return $seconds + ($microseconds / 1_000_000); } 1; #----------------------------- # download the following standalone program #!/usr/bin/perl -w # jam - stuff characters down STDIN's throat require 'sys/ioctl.ph'; die "no TIOCSTI" unless defined &TIOCSTI; sub jam { local $SIG{TTOU} = "IGNORE"; # "Stopped for tty output" local *TTY; # make local filehandle open(TTY, "+</dev/tty") or die "no tty: $!"; for (split(//, $_[0])) { ioctl(TTY, &TIOCSTI, $_) or die "bad TIOCSTI: $!"; } close(TTY); } jam("@ARGV\n"); #----------------------------- #% cat > tio.c <<EOF && cc tio.c && a.out ##include <sys/ioctl.h> #main() { printf("%#08x\n", TIOCSTI); } #EOF #0x005412 #----------------------------- # download the following standalone program #!/usr/bin/perl # winsz - find x and y for chars and pixels require 'sys/ioctl.ph'; die "no TIOCGWINSZ " unless defined &TIOCGWINSZ; open(TTY, "+</dev/tty") or die "No tty: $!"; unless (ioctl(TTY, &TIOCGWINSZ, $winsize='')) { die sprintf "$0: ioctl TIOCGWINSZ (%08x: $!)\n", &TIOCGWINSZ; } ($row, $col, $xpixel, $ypixel) = unpack('S4', $winsize); print "(row,col) = ($row,$col)"; print " (xpixel,ypixel) = ($xpixel,$ypixel)" if $xpixel || $ypixel; print "\n"; #----------------------------- |
#----------------------------- #% perl Makefile.PL #% make #----------------------------- #% h2xs -cn FineTime #----------------------------- #% perl Makefile.PL #----------------------------- #'LIBS' => [''], # e.g., '-lm' #----------------------------- #'LIBS' => ['-L/usr/redhat/lib -lrpm'], #----------------------------- #% perl Makefile.PL LIB=~/perllib #----------------------------- package FineTime; use strict; use vars qw($VERSION @ISA @EXPORT_OK); require Exporter; require DynaLoader; @ISA = qw(Exporter DynaLoader); @EXPORT_OK = qw(time); $VERSION = '0.01'; bootstrap FineTime $VERSION; 1; ##----------------------------- ##include <unistd.h> ##include <sys/time.h> ##include "EXTERN.h" ##include "perl.h" ##include "XSUB.h" # #MODULE = FineTime PACKAGE = FineTime # #double #time() # CODE: # struct timeval tv; # gettimeofday(&tv,0); # RETVAL = tv.tv_sec + ((double) tv.tv_usec) / 1000000; # OUTPUT: # RETVAL #----------------------------- #% make install #mkdir ./blib/lib/auto/FineTime #cp FineTime.pm ./blib/lib/FineTime.pm #/usr/local/bin/perl -I/usr/lib/perl5/i686-linux/5.00403 -I/usr/lib/perl5 #/usr/lib/perl5/ExtUtils/xsubpp -typemap # /usr/lib/perl5/ExtUtils/typemap FineTime.xs #FineTime.tc && mv FineTime.tc FineTime.ccc -c -Dbool=char -DHAS_BOOL # -O2-DVERSION=\"0.01\" -DXS_VERSION=\"0.01\" -fpic # -I/usr/lib/perl5/i686-linux/5.00403/CORE #FineTime.cRunning Mkbootstrap for FineTime () #chmod 644 FineTime.bs #LD_RUN_PATH="" cc -o blib/arch/auto/FineTime/FineTime.so # -shared -L/usr/local/lib FineTime.o #chmod 755 blib/arch/auto/FineTime/FineTime.so #cp FineTime.bs ./blib/arch/auto/FineTime/FineTime.bs #chmod 644 blib/arch/auto/FineTime/FineTime.bs #Installing /home/tchrist/perllib/i686-linux/./auto/FineTime/FineTime.so #Installing /home/tchrist/perllib/i686-linux/./auto/FineTime/FineTime.bs #Installing /home/tchrist/perllib/./FineTime.pm #Writing /home/tchrist/perllib/i686-linux/auto/FineTime/.packlist #Appending installation info to /home/tchrist/perllib/i686-linux/perllocal.pod #----------------------------- #% perl -I ~/perllib -MFineTime=time -le '1 while print time()' | head #888177070.090978 # #888177070.09132 # #888177070.091389 # #888177070.091453 # #888177070.091515 # #888177070.091577 # #888177070.091639 # #888177070.0917 # #888177070.091763 # #888177070.091864 #----------------------------- |
#----------------------------- #=head2 Discussion # #If we had a I<.h> file with function prototype declarations, we #could include that, but since we're writing this one from scratch, #we'll use the B<-c> flag to omit building code to translate any #C<#define> symbols. The B<-n> flag says to create a module directory #named I<FineTime/>, which will have the following files. #----------------------------- #=for troff #.EQ #log sub n (x) = { {log sub e (x)} over {log sub e (n)} } #.EN #----------------------------- #=for later #next if 1 .. ?^$?; #s/^(.)/>$1/; #s/(.{73})........*/$1<SNIP>/; # #=cut back to perl #----------------------------- #=begin comment # #if (!open(FILE, $file)) { # unless ($opt_q) { #) # warn "$me: $file: $!\n"; # $Errors++; # } # next FILE; #} # #$total = 0; #$matches = 0; # #=end comment #----------------------------- |
#----------------------------- #% gunzip Some-Module-4.54.tar.gz #% tar xf Some-Module-4.54 #% cd Some-Module-4.54 #% perl Makefile.PL #% make #% make test #% make install #----------------------------- #% gunzip MD5-1.7.tar.gz #% tar xf MD5-1.7.tar #% cd MD5-1.7 #% perl Makefile.PL #Checking if your kit is complete... # #Looks good # #Writing Makefile for MD5 # #% make #mkdir ./blib # #mkdir ./blib/lib # #cp MD5.pm ./blib/lib/MD5.pm # #AutoSplitting MD5 (./blib/lib/auto/MD5) # #/usr/bin/perl -I/usr/local/lib/perl5/i386 ... # #... # #cp MD5.bs ./blib/arch/auto/MD5/MD5.bs # #chmod 644 ./blib/arch/auto/MD5/MD5.bsmkdir ./blib/man3 # #Manifying ./blib/man3/MD5.3 # #% make test #PERL_DL_NONLAZY=1 /usr/bin/perl -I./blib/arch -I./blib/lib # #-I/usr/local/lib/perl5/i386-freebsd/5.00404 -I/usr/local/lib/perl5 test.pl # #1..14 # #ok 1 # #ok 2 # #... # #ok 13 # #ok 14 # #% sudo make install #Password: # #Installing /usr/local/lib/perl5/site_perl/i386-freebsd/./auto/MD5/ # # MD5.so # #Installing /usr/local/lib/perl5/site_perl/i386-freebsd/./auto/MD5/ # # MD5.bs # #Installing /usr/local/lib/perl5/site_perl/./auto/MD5/autosplit.ix # #Installing /usr/local/lib/perl5/site_perl/./MD5.pm # #Installing /usr/local/lib/perl5/man/man3/./MD5.3 # #Writing /usr/local/lib/perl5/site_perl/i386-freebsd/auto/MD5/.packlist # #Appending installation info to /usr/local/lib/perl5/i386-freebsd/ # #5.00404/perllocal.pod #----------------------------- # if you just want the modules installed in your own directory #% perl Makefile.PL LIB=~/lib # # if you have your own a complete distribution #% perl Makefile.PL PREFIX=~/perl5-private #----------------------------- |
#----------------------------- package Some::Module; # must live in Some/Module.pm use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); # set the version for version checking $VERSION = 0.01; @ISA = qw(Exporter); @EXPORT = qw(&func1 &func2 &func4); %EXPORT_TAGS = ( ); # eg: TAG => [ qw!name1 name2! ], # your exported package globals go here, # as well as any optionally exported functions @EXPORT_OK = qw($Var1 %Hashit &func3); use vars qw($Var1 %Hashit); # non-exported package globals go here use vars qw(@more $stuff); # initialize package globals, first exported ones $Var1 = ''; %Hashit = (); # then the others (which are still accessible as $Some::Module::stuff) $stuff = ''; @more = (); # all file-scoped lexicals must be created before # the functions below that use them. # file-private lexicals go here my $priv_var = ''; my %secret_hash = (); # here's a file-private function as a closure, # callable as &$priv_func. my $priv_func = sub { # stuff goes here. }; # make all your functions, whether exported or not; # remember to put something interesting in the {} stubs sub func1 { .... } # no prototype sub func2() { .... } # proto'd void sub func3($$) { .... } # proto'd to 2 scalars # this one isn't auto-exported, but could be called! sub func4(\%) { .... } # proto'd to 1 hash ref END { } # module clean-up code here (global destructor) 1; #----------------------------- |
#----------------------------- #% pmdesc #----------------------------- #FileHandle (2.00) - supply object methods for filehandles # #IO::File (1.06021) - supply object methods for filehandles # #IO::Select (1.10) - OO interface to the select system call # #IO::Socket (1.1603) - Object interface to socket communications # #... #----------------------------- #% pmdesc -v # #<<<Modules from /usr/lib/perl5/i686-linux/5.00404>>> # # #FileHandle (2.00) - supply object methods for filehandles # # ... #----------------------------- # download the following standalone program #!/usr/bin/perl -w # pmdesc - describe pm files # tchrist@perl.com use strict; use File::Find qw(find); use Getopt::Std qw(getopts); use Carp; use vars ( q!$opt_v!, # give debug info q!$opt_w!, # warn about missing descs on modules q!$opt_a!, # include relative paths q!$opt_s!, # sort output within each directory ); $| = 1; getopts('wvas') or die "bad usage"; @ARGV = @INC unless @ARGV; # Globals. wish I didn't really have to do this. use vars ( q!$Start_Dir!, # The top directory find was called with q!%Future!, # topdirs find will handle later ); my $Module; # install an output filter to sort my module list, if wanted. if ($opt_s) { if (open(ME, "-|")) { $/ = ''; while (<ME>) { chomp; print join("\n", sort split /\n/), "\n"; } exit; } } MAIN: { my %visited; my ($dev,$ino); @Future{@ARGV} = (1) x @ARGV; foreach $Start_Dir (@ARGV) { delete $Future{$Start_Dir}; print "\n<<Modules from $Start_Dir>>\n\n" if $opt_v; next unless ($dev,$ino) = stat($Start_Dir); next if $visited{$dev,$ino}++; next unless $opt_a || $Start_Dir =~ m!^/!; find(\&wanted, $Start_Dir); } exit; } # calculate module name from file and directory sub modname { local $_ = $File::Find::name; if (index($_, $Start_Dir . '/') == 0) { substr($_, 0, 1+length($Start_Dir)) = ''; } s { / } {::}gx; s { \.p(m|od)$ } {}x; return $_; } # decide if this is a module we want sub wanted { if ( $Future{$File::Find::name} ) { warn "\t(Skipping $File::Find::name, qui venit in futuro.)\n" if 0 and $opt_v; $File::Find::prune = 1; return; } return unless /\.pm$/ && -f; $Module = &modname; # skip obnoxious modules if ($Module =~ /^CPAN(\Z|::)/) { warn("$Module -- skipping because it misbehaves\n"); return; } my $file = $_; unless (open(POD, "< $file")) { warn "\tcannot open $file: $!"; # if $opt_w; return 0; } $: = " -:"; local $/ = ''; local $_; while (<POD>) { if (/=head\d\s+NAME/) { chomp($_ = <POD>); s/^.*?-\s+//s; s/\n/ /g; #write; my $v; if (defined ($v = getversion($Module))) { print "$Module ($v) "; } else { print "$Module "; } print "- $_\n"; return 1; } } warn "\t(MISSING DESC FOR $File::Find::name)\n" if $opt_w; return 0; } # run Perl to load the module and print its verson number, redirecting # errors to /dev/null sub getversion { my $mod = shift; my $vers = `$^X -m$mod -e 'print \$${mod}::VERSION' 2>/dev/null`; $vers =~ s/^\s*(.*?)\s*$/$1/; # remove stray whitespace return ($vers || undef); } format = ^<<<<<<<<<<<<<<<<<~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $Module, $_ . #----------------------------- |