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); #----------------------------- @{
#----------------------------- $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);
#----------------------------- $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); #-----------------------------
# 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"; #-----------------------------
#----------------------------- 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; #-----------------------------
#----------------------------- #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";
#----------------------------- #=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; }
# 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)
#----------------------------- #% 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; } }
# 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;
7780
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
