-
Notifications
You must be signed in to change notification settings - Fork 0
tomgreen98/Intermediate-Perl-Class
Folders and files
Name | Name | Last commit message | Last commit date | |
---|---|---|---|---|
Repository files navigation
Notes: Instructor: brian d foy Version: 3.1 Date: 10/14/2013 perldoc perlvar perldoc -f eval perldoc -q comma perldoc perlop http:://perldoc.perl.com ------------------------------------------- Review of grep: ------------------------------------------- my @numbers = 1..1000; my @odd_numbers; foreach (@numbers) { push @odd_numbers, $_ if $_ % 2; } or my @odd_numbers = grep $_ % 2, 1..1000; my @result = grep expression, list; As in foreach $_ is aliased to the elements of the original list, careful, don't change $_ unless you intend to change the original list. also: my @matching = grep /\bMinow\b/, <FILE>; # gets the matching lines Perl Power Tools - adds perl implemenations of grep and other linux stuff to Windows. COOL *** ------------------------------------------- Review of map: ------------------------------------------- my @foods = qw/ COCONUTS Rice mangoes Wild_boar /; my @good_case; foreach (@foods) { push @good_case, "\u\L$_"; } or my @good_case = map "\u\L$_", @foods; Can be used inline. print "The foods are:\n", map " $_\n", @good_case; Its all list processing. Just like the linux pipeline. Called the UNIX toolbox. LISP - also very good at this... Higher Order Perl - Mark Jas Perl has 6 of the 7 things that define LISP. Case Shifters in string interpretation. Call a subroutine: my @files &funct($_), glob "*"; my @strings = map &funct($_), <FILE>; ------------------------------------------- Annomyous subroutine: ------------------------------------------- my @strings = map { my $copy = $_; $copy =~ s/^\s+//; $copy; # return } <FILE> ($new = $orig) =~ s///; $new = $orig =~ s///r; # 5.14 /r returns results instead of count. @out = map { s/// } @in; # array of counts substitute @out = map { s///r } @in; # array of strings with substitutes. ------------------------------------------- Mapping one to many: ------------------------------------------- my @file_names = glob "*"; my @names_and_sizes = map { $_, -s } @file_names; my %size_of = @names_and_sizes; # Shorter version my %size_of = map { $_, -s } glob "*"; my @words = map split, <FILE>; # splits the whole file into words. my @comments = map /#\s*(.*)/, <INPUT>; # a list of # comments ------------------------------------------- Review of eval: ------------------------------------------- String form - bad one, genearally execute string as perl code. Block form - eval { open FH, $file or die "This is caught in $@"; some_sub_that_dies(); #This is caught too } if ($@) { ... } Does not trap normal execution, such as exit or warnings. The code in the eval block must compile. It doesn't catch syntax errors. die "xxx"; # xxx file# line# die "xxx/n" # xxx ------------------------------------------- Introduction to References ------------------------------------------- my @last_three = pop_n(3, @foos); passed a n+1 item list 3, ?, ?, ?, ?, ... my @last_three = pop_n(3, \@foos); passes a 2 item list. 3, ref @foos PeGS... Write a Perl module to generate PeGS. $ref = \@count | ref > | count > =========== | * | ------------> 5 4 3 2 1 A reference is just a scalar. sub pop_n { my ($n, $array_ref) = @_; ... } $array_ref is just a "pointer" to the array. Daily WTF. printf "%${width}s\n"; # ahha here is the fix to $abc_abb where ${abc}_abb. @array = @{$array_ref}; Its just about naming... sub pop_n { my ($n, $array_ref) = @_; my @items; for (1..$n) { my $item = pop @{ $array_ref }; unshift @items, $item; } @items; #return value. } # Test it now... my @foods = qw/ clam coconut fish /; my @last_3 = pop_n(3 \@foods); print "@foods\n"; If you pass in 0 for $n? 1..0 => undef, returns @items -> undef. Additional ways to access an array: my $count = @{$array_ref}; my $last = $#{$array_ref}; my @two = @{$array_ref} [1, 2]; Hash references: my $ref = \%file_size; ${$ref}{item} = ??? @{$ref}[0] Scalar references: How to make perl release memory? sub strip_span { my $string_ref = shift; $$string_ref =~ s/<\?span.*?>//s; } Passing a scalar by value creates a copy. Pass by reference is better for big data, think strings. You can compare references to see if they point to the same data. Modifying the array: my @gilligan = qw(red_shirt hat lucky_socks water_bottle); check_required_items("gilligan", \@gilligan); sub check_required_items { my $who = shift; my $items = shift; my %items = map { $_, 1} @$items; state @required = qw(preserver sunscreen water_botle jacket); # state requires 5.10. (similar to static, initialized the first time only.) my @missing = (); foreach my $item (@requried) { unless (exists $items{$item}) { print push @missing, $item; } } if (@missing) { print "Adding @missing to @$items for $who.\n"; push @$items, @missing; } } Defereferenceing with deeply nested structures gets very complicated. Prefer to use the -> to do the dereference. $all[2]->[1]->[0] = ${ ${ $all[2] } [1] }[0]; also you can use: $all[2][1][0] another way to build the hash: @names = qw(skipper, gilligan, professor); %all = map { $_, \@{"$_"} } @names; #doesn't work in strict, there is another way too coming up. #don't do that... %main:: -> stash - tracks all the stuff. foreach (keys %main::) { next unless defined @{"$_"}; print "$_\n"; } masteringperl.org -> new book by brian d foy. intermediateperl.com -> this book. How to use state actually? state $required = [preserver sunscreen water_bottle life_jacket]; # should work. -------------------------- References and Scoping: -------------------------- my $ref = \@count; my $ref2 = $ref; or my $ref2 = \@count; Just a new name for the same reference. When things go out of scope, the name dissapears, the data sticks around until all the references are released. sub get_personal_info { local $_; my $who = shift; open (FILE, "clothing-size") or die "Can't open clithing-size file: $!"; chomp($_ = <FILE>); my @headings = split /\t/; while(<FILE>) { chomp; my @data = split /\t/; next unless $data[0] eq $who; my %hash; @hash{@headings} = @data; # Hash slice assigns each data to each key close FILE; return \%hash; } close FILE; (); } HoA -> Hash of Arrays HoH -> Hash of Hashes >> perldsc ---------------------- Auto-vivification: ---------------------- my %total_bytes; while(<>) { my ($source, $dest, $bytes) = split; $total_bytes{$source}{$destination} += $bytes; } How to disable auto-vivication? use autovivification; calls import(); use x; => BEGIN {require x; x->import;} no autovivificaiton; no x; => BEGIN {require x; x->unimport;} --------------- Destruction --------------- Add a ref ++ refcount Remove a ref -- refcount Once the refcount is 0, perl may release the memory, may not be right a way.... Can cause problems where structures cross reference each other. Stephen (Linked list in perl) ----------------------- Prototypical Checking ----------------------- if (ref $some eq ref [] ) { ... } # array ref if (ref $some eq ref {} ) { ... } # hash ref if (ref $some eq ref qr() ) { ... } # regex ref ----------------------- Section 5: Manipulating Complex Data Structures ----------------------- What is a good perl visual debugger? log for perl Debuggers: Devel::REPL Devel::hdb ------------------------------------------- Printing a structured value for debugging ------------------------------------------- Data::Dumper; ------------------ Add column names: ------------------ print Data::Dumper->Dump( [ \%people, [ qw(a b c) ], [ qw(*people *array)], ) * means add the correct type. Data::Dump::Streamer - has fancier features. Data::Printer - p %hash; ------------------ YAML: ------------------ use YAML; print Dump( \%people, [qw(a b c)]); Now it outputs YAML... To get it back: use YAML; my ($people, $array) = Load( $string ); YAML never evals so its safer... Its available in other languages There are other implementations: * YAML::Tiny * YAML::Syck Security issues: CGI::SpecFile DESTROY { unlink $$_[0]; } And Storable can be passed a string that can be iterpreted as this CGI::SpecFile class. Opps, you can unlink any file. YUCK. ---------------------------- Persistence with Storable ---------------------------- Sereal - Fixes all the known problems with Storable. ---------------------------- Subroutine References ---------------------------- Reduce repetition. my $func_ref = \&func; &func_ref(); &{$func_ref}(); &$func_ref(); $func_ref->(); # Added just before 5.04 released. All these call the same function the same way... Using multipe coderefs: foreach my $greet_ref (\&a_greet, \&b_greet, \&c_greet) { $greet_ref->(); } ---------------------------- Anonymous Subroutine: ---------------------------- my $func_ref = sub { ... } ASSIDE: (Cool use for state to get the loop counter.) @output_list = map { state $n = 0; say "on element", $n++; } @in; ---------------------------- Callbacks: ---------------------------- use File::Find; sub what_to_do { print "$File::Find::name found.\n"; } my @starting_points = qw{ . }; find(\&what_to_do, @starting_points); There are several more variables: ASSIDE: find2perl -> creates a perl subroutine that works like the find linux call, but all native perl and often more efficent since doesn't pipe to output processing... ---------------------------- Lexical variables in a surrounding scope ---------------------------- use File::Find; my ($total_files, $total_bytes) = (0,0); find( sub { return if -l or not -f _; # Not a link or not a file $total_files++; $total_bytes += -s _; }, "." ); print "Total: $total_bytes bytes in $total_files files.\n"; ---------------------------- Closures ---------------------------- my $callback; { # In the private scope my $count = 0; $callback = sub { # Creates a closure print ++$count, ": $File::Find::name\n"; #$count has a refcount of 2 } } #$count has a refcount of 1, so its still around find ($callback, "."); The above can be implemented with state in modern 5.010+ without the extra scope block. --------------------------- Return a closure --------------------------- use File::Find; sub create_find_counter { my $count = 0; return sub { print ++$count, ": $File::Find::name\n"; } } my $callback1 = create_find_counter(); my $callback2 = create_find_counter(); each have an independent count. -------------------------------- Shared variables among closures -------------------------------- use File::Find; sub find_callback_and_report() { my ($total_files, $total_bytes) = (0,0); my $calc = sub { return if -l or not -f _; # Not a link or not a file $total_files++; $total_bytes += -s _; }; my $report = sub { print "Total: $total_bytes bytes in $total_files files.\n"; } ); my ($calc, $report) = find_callback_and_report(); find($calc, "."); find($calc, "./ab"); find($calc, "./ac"); $report->(); ----------------------------- File::Find::Closures ----------------------------- ----------------------------- state variables ----------------------------- use 5.010; or use v5.10; ----------------------------- END blocks ----------------------------- BEGIN blocks execute top to bottom END blocks execute bottom to top only run if running is normal, not for crashes. Cool new feature in perl 6: $begin <= $m >= $end Can we port this??? ------------------------------- Filehandle and Regex References ------------------------------- open my $fh, "..." or die "???: $!"; while (<$fh>) { print "One entry" } another way open my $fh, '>>', 'xxx.txt' or die "$!"; print_to_this($fh); sub print_to_this { my $fh = shift; print $fh "Ayyy"; } also: print {$fh} "xxx\n"; # helps clairify the distinction of a fh. the above are required if the file handle is stored in anything but the scalar. print {$array[0]}, "xxx\n"; -------------------- many files at once -------------------- foreach my $file (glob "*.in") { (my $out = $file) =~ s/\.in$/.out/; open my $input... open my $output... push @handle_pairs, [$input, $output]; } while (@handle_pairs) { @handle_pairs = grep { if (defined(my $line = readline($_->[0]))) { print { $_->[1]} $line; } else { 0; } } @handle_pairs; } as the file handles go out of scope, they are automatically closed. This seems pretty obscure syntax for this process. --------------------- Specialized handles --------------------- --------------------- File handles on scalars --------------------- open my $fh, ">", \ my $string; print $fh "Foo"; Books: * Effective Perl Programming * Network Programmin in Perl --------------------- Regexs, old way --------------------- my $what = 'Gill.*n'; if (/$what/) { } These cost a lot since they are recompiled all the time. Better to compile once. --------------------- Refernce to Regex --------------------- my $regex = qr/Gill.*n/; #Compiles ASSIDE: Shows the code that perl thinks it has perl -MO=Deparse -e '@$^R;'; ----------------------- Practical Ref Tricks ----------------------- # Step 1, cache the file and size in array. my @files = glob "*"; my @files_and_sizes = map [ $_, -s ], @files; # Sort by size my @sorted_refs = sort { $b->[1] <=> $a->[1] } @ files_and_sizes; my @sorted_files = map $_->[0] @sorted_refs; -------------------------- The Schwartzian Transform -------------------------- Randel Schwartz my @sorted_files = map $_->[0], sort { $b->[1] <=> $a->[1] } map [$_, -s], glob "*"; # Same results as above without all the intermediate variables ---------------------------- Recursive Data Structures ---------------------------- $homedir = &gather("/home"); sub gather { my $dir = shift; opendir GATHER, $dir or return; my @kids = readdir GATHER; my %self; foreach my $kid (@kids) { next if $kid eq "." or $kid eq ".."; $self{$kid} = &gather("$dir/$kid"); } return \%self; } #works now lets play with the data structure: sub display { my ($label, $node) = @_; if (not $node) { print "$label\n"; } elsif (my @contents = keys %$node) { print "$label, with contetns of:\n"; ... } else { } } #OK, but ugg. Some compilers can optimize this to remove the recursion... TelCall optimization not available in perl since we can redefine stuff (Dynamic Language) How do we convert this to an iterative solution? my @queue = ( ["/home", {}] ); while( $e = shift @queue ) { opendir /home ---> keys push @queue [ $key, $e->[1]]; } # Nice thing is we can push, unshift or insert so we can control depth first, breadth first or other.... we can skip things, we can trim at a certain depth... www.perlmonks.org/?node_id=393128 playing with dumbbench http://www.masteringperl.org/2013/02/playing-with-dumbbench/ ----------------------------- Libraries and Packages ----------------------------- require - loads a file, checked its cache first, if it doesn't work, it dies. looks for a true value for the last statement to be true. 1; # at the end of the file How to find the library? * Full path. * Partial path from root. (Searches @INC list) * perl -V - shows all the global variables ways to change the @INC list: setenv PERL5LIB ... PERL5LIB=...; export PERL5LIB; perl -I "path" ---------------------------- Namespace collision ---------------------------- last definition wins. with perl 5 adds packages. ---------------------------- Declaring shared package variables??? (old way) ---------------------------- package a; use vars qw/ @labels @sizes @garmennts /; ---------------------------- Declaring shared package variables??? (new way) ---------------------------- package a; our ($a, $b, $c); How to get the package information. $package=__PACKAGE__; ($package, $file, $line) = caller(o); ----------------------- Object Oriented Perl ----------------------- sub Cow::speak {}; sub Horse::speak {}; sub Sheep::speak {}; my @pasture = qw(Cow Cow Horse Sheep Sheep); foreach my $beast (@pasture) { &{ $beast . "::speak"}; } # doesnt work in strict my @pasture = qw(Cow Cow Horse Sheep Sheep); foreach my $beast (@pasture) { $beast->speak(); } # this is strict safe -------------------------- Class->method(@args) => Class::method("Class", @args) -------------------------- { package Cow; sub sound { "moooo" }; sub speak { my $class = shift; print "a $class goes", $class->sound, "!\n"; } } { package Sheep; ... } { package Horse; .... } --------------------- the speak sub routine is now generic. { package Animal; sub speak { my $class = shift; print "a $class goes", $class->sound, "!\n"; } } { package Cow; @ISA = qw(Animal); # Parent class sub sound { "moooooo" }; } # Pretty simple. How does it work? Cow->speak Cow::speak ??? no Looks in parent packages Animal::speak ??? yes &Animal::speak("Cow", @args); Same process is used for the sound() method called by speak(). 1) Look in current package 2) Look in each class defined in @ISA. ------------------ Specialization ------------------ { package Mouse; @ISA = qw(Animal); sub sound { "squeak" }; sub speak { my $class = shift; $class->SUPER::speak; # Calls the parent class print "[but you can barely hear it!]\n"; } } ------------------- Bless ------------------- Turns a reference into an object. my $name = "Mr. Ed"; my $talking = \$name; bless $talking, "Horse"; $talking is a Horse now... print $talking->speak(), "\n"; results in: Horse->speak($talking); ------------------- { package Horse; sub name { my $self = shift; $$self; } } -------------------- Constructors -------------------- Name of constructor can be anything. More like a factory method. { package Horse; sub named { # Im the constructor... my $class = shift; my $name = shift; bless \$name, $class; } } my $talking = Horse->named("Mr. Ed"); print $talking->name, " says ", $talking->sound, "!\n"; >> Mr. Ed says neigh! Raymond Shen (Microsoft win32 guy) --------------------- { package Animal; sub speak { my $either = shift; # Class or Instance print $either->name, " says ", $either->sound, "!\n" } sub name { my $either = shift; ref $either ? $$either : "Unnamed"; } } ----------------------- now lets make them eat. { pacakge Animal; sub eat { my $either = shift; my $food = shift; print $either->name, " eats $food. \n"; } } my $talking = Horse->named("Mr. Ed"); $talking->eat("hay"); Cow->eat("grass"); ------------------------- More interesting classes ------------------------- my $lost = bless { Name => "Babes", Color => "white", } { package Animal; sub named { my $class = shift; my $name = shift; my $self = { Name => $name, Color => $class->default_color }; bless $self, $class; } sub name { my $either = shift; ref $either ? $either->{Name} : "unnamed $either"; } sub default_color { "brown"; } sub color { # Getter/Setter my $self = shift; if (@_) { $self->{Color} = shift; } else { $self->{Color}; } } } Some things should only work with the class and some only with the color. sub class_only { if (ref (my $class = shift) { die "class name needed"; }) } another way: use Carp qw(croak); sub class_only { my $class = shift; croak "class name needed" if ref $class; # give you the caller } carp - returns in function context confess - like croak with stack trace cluck - like carp with stack trace --------------------- Destructors --------------------- sub DESTROY { } Weird other way to write perl: print STDOUT "Hello"; # indirect object notation. STDOUT->print("Hello"); Generally we don't want to use indirect object notation. ---------------------- Class variables -> Like static ---------------------- { package Animal; our %REGISTRY; sub factory { my $class = shift; my $name = shift; my $self = { 'name' => $name, 'color' => $class->default_color(), }; $REGISTRY{$self} = bless $self, $class; } sub registry_report { } } Animals can't die since there is always a ref in the REGISTRY. One way to solve this is to use Weakening. { package Animal; our %REGISTRY; sub factory { my $class = shift; my $name = shift; my $self = { 'name' => $name, 'color' => $class->default_color(), }; $REGISTRY{$self} = bless $self, $class; weaken($REGISTRY{$self}); #dec ref count } sub DESTROY { } sub registry_report { } } --------------------- Universal Methods --------------------- Like the root object of all other objects. UNIVERSAL::isa("???"); # only works on blessed objects grep eval { $_->isa() }; # tests if the $_ is blessed UNIVERSAL::can("eat"); # does the class implement the eat method. if (eval { $thing->can("eat")} ) { $thing->eat("hay and oats"); } ----------------------- AUTOLOAD ----------------------- sub AUTOLOAD { our AUTOLOAD; (my $method = $AUTOLOAD) =~ s/.*:://; if ($method eq "vaccinate") { # create the methods } else { ??? } } AutoLoader was popular for a while, but has gone out of favor, perhape because computers have gotten so much faster. If you see: Can't find method foo.a1 SelfLoader also not used anymore. loads optional methods dynamically only when needed. put optional methods below __DATA__ -------------------- multiple inheritance -------------------- { package RaceHorse; our @ISA = qw ( Horse Racer ); } Order of classes gets complicated though for fall through methods. Process stack for first ISA, followed by second ISA, followed... mro - perl 5.010; # method resolution order --------------------- modules --------------------- # Function oriented interface use File::Basename ("fileparse", "basename"); use File::Basename qw(fileparse basename); File::Basename::dirname(); # fully resolved use File::Basename(); # dont import anything. use File::Basename; # import the defaults. # Object oriented interface use File::Spec; my $filespec = File::Spec->catfile($homedir, 'web_docs', "photos", "pic.gif"); # generates /home/abc/web_docs/photos/pic.gif ------------------------- use Island::Plotting::Maps qw( a b c d ); results in: BEGIN { require Island::Plotting::Maps; Island::Plotting::Maps->import( qw ( a b c d) ); } results in: BEGIN { require "Island/Plotting/Maps.pm; Island::Plotting::Maps->import( qw ( a b c d) ); } To define this module: package Island::Plotting::Maps; sub a {} sub b {} sub c {} sub d {} 1; --------------------------- use --------------------------- use lib "/home/ab/lib"; -> BEGIN { unshift @INC, "/home/ab/lib"}; #use use lib preferably... --------------------------- Importing with Exporter --------------------------- package Island::Plotting::Maps; our @EXPORT = qw( a b c d); # defaults our @EXPORT_OK = qw( e f ); # allowed to be exported, but not by default use Exporter; our @ISA = qw(Exporter); sub a {} sub b {} sub c {} sub d {} sub e {} sub f {} 1; For an OO model its different package My::OOModule::Base; our @EXPORT = (); use Exporter; our @ISA = qw(Exporter); or package My::OOModule::Base; use base qw( Exporter ); #5.010 > ------------------------- Writing a distribution ------------------------- Alien on CPAN -> native c binding for libs Private CPAN ??? Tool to convert c header files into perl modules: h2xs. Many uses. To make basic perl distributions: h2xs -XAn <NameSpace> creates the boiler plate. >>perl -MCPAN -eshell cpan> readme <NameSpace> or >>cpan or >>cpanm -> cpanminus README = human text, not favored much now. Changes = list of ver, date, who, and what changed. .pm = prebuild template for the main module more on export: our %EXPORT_TAGS = ( 'all' => [ qw() ], 'special' => [ qw() ] ); To get a libaray with a specific version or greater: use abc::def 1.10 (); to get a specific version: use Foo; unless (Foo->Version eq '1.23') { die ""; } perls version system uses 3 digits after the decimal. 1.000 - 1.999 POD: =head1 NAME =head1 SYNOPSIS =head1 ABSTRACT =head1 DESCRIPTION =head2 EXPORT =head1 AUTHOR =head1 COPYRIGHT AND LICENSE =head3 CLASS =head4 DESCRIPTION =head4 EXAMPLE =head4 METHODS =head5 METHOD =head6 NAME =head6 DESCRIPTION =head6 ARGS =head6 =head4 PROPERTIES =head4 ATTRIBUTES =cut =over # =item * =item 1 =back I<italic> B<bold> S<nbsp;> E<Auml> - entities - better to use unicode characters though Put at the top of the file if you want to use unicode in your POD =encoding utf8 Unicode Checker - website with all the unicode Keyboard utilitiy on mac to show visual keyboard. pod2text pod2html pod2man ... Lots of converters. podchecker - checks your POD syntax CPAN::Mini::Webserver - Keeps a part of CPAN on your machine. will download the latest versions of CPAN modules. You can also limit it to only selected modules. MyCPAN DPAN DOXYGEN ------------------- something.PL -> generates another file something.pl as part of the build process. perl Makefile.PL PREFIX=~/Testing -> creates the module in the home folder. ------------------- perl -M local::lib -e0 perlbrew - allows you to have mutiple versions of perl installed. perlall? or perlalt? - Renis tool -------------------- Makefile.PL WriteMakefile( ... ) META.yml - generated by WriteMakefile META.json - generated by WriteMakefile --------------------- Testing --------------------- >> make test $VERSION = 1.12_001 -> everything after the underscore means its for development. CPAN TESTERS - When you upload a new or updated module, the cpan testers automatically smoke test your code. Free distributed testing. Test Files TODO: { local $TODO = ''; } SKIP: { skip $n, $why unless $cond; } ---------------------- Install ---------------------- make install ---------------------- Distribute your stuff ---------------------- make dist -> *.tar.gz ---------------------- Testing ---------------------- Curtis 'Ovid' Poe - Big testing guy. Also helps people get jobs in Europe. use_ok($class) or print "BAILOUT!..."; 00.load.t use_ok($class) or print "BAILOUT!..."; use_ok($class) or print "BAILOUT!..."; use_ok($class) or print "BAILOUT!..."; use_ok($class) or print "BAILOUT!..."; in newer version: BAILOUT(); method When starting off: ----------------------- use Test::More tests => big number... or use Test::More; done_testing(); or use Test::More 'no_plan'; * Higher Order Perl
About
Intermediate Perl with brian d foy
Resources
Stars
Watchers
Forks
Releases
No releases published
Packages 0
No packages published