Thinking+in+Perl

nullThinking in Perl --Perl DBIThinking in Perl --Perl DBI Charlie Cao (Cao, Xiaobing) CMB Ext. 78272ContentsContentsOverview Data Types Variables Common Predefined Variables Constants Reference Control Structures Terseness Regular Expression Subroutines Using Modules DBI (Database Interface) Convert DBLib to DBI (DBD)What is Perl?What is Perl?Perl is short for " Practical Extraction and Report Language“ (Pathologically Eclectic Rubbish Lister) designed by Larry Wall (12, Dec. 1987). Perl is a general-purpose programming language originally developed for text manipulation and now used for a wide range of tasks including system administration, web development, network programming, GUI development, and more. The language is intended to be practical (easy to use, efficient, complete) rather than beautiful (tiny, elegant, minimal). Its major features are that it's easy to use, supports both procedural and object-oriented (OO) programming, has powerful built-in support for text processing, and has one of the world's most impressive collections of third-party modules.Running Perl programsRunning Perl programsWindows (ActivePerl 5.10, Download): perl sample.pl sample.pl perl < sample.pl perl -e "print 'hello world!'" Unix/Linux (Perl 5.8.0): perl sample.pl chmod 0777 (a+x) sample.pl sample.pl (#!/export/opt/perl/5.8.0/bin/perl) perl < sample.pl perl -e "print 'hello world!'“Perldoc commandPerldoc command>perldoc perl – Overview of Perl language >perldoc [module name (e.g DBI)] – help doc of the module >perldoc –f (subroutine name (e.g split)) – help doc of the subroutineEmulated IDE- Ultra EditEmulated IDE- Ultra EditEmulated IDE- Ultra EditEmulated IDE- Ultra EditEmulated IDE- Ultra EditEmulated IDE- Ultra EditData TypesData TypesScalar Integer 0 -40 255 61298040283768 61_298_040_283_768 Float 1.25 255.000 7.25e45 -6.5e24 -12e-24 Octal 047 ~ 49 (Dec) Hex 0x1f ~ 31 (Dec) Binary 0b11111111 ~255 (Dec)Data TypesData TypesScalar String Double quote: $result = 14; print ("The value of \$result is $result.\n") #The value of $result is 14.Data TypesData TypesScalar String Single quote: $text = 'This is two   lines of text   '; ~~~~~~~~~~~~~~~~~~~~~~~~~~~ $text = "This is two\nlines of text\n"; Subroutines: q /Hello world/ # gets ‘ Hello world’ qq /Hello world/ # gets “Hello world” length($string); substr(string, offset, length) uc/lc(string) join(expr, list) # $text = join('', @lines); ltrim/rtrim(string) Data TypesData TypesScalar String/Numeric conversion $string = "43"; $number = 28; $result = $string + $number; # $result = 71 $result = $string.$number; # $result = "4328“ $result = $string x 3; # $result = "434343“ $result = "hello" * 5; # $result = 0 $result = "12a34" +1; # $result = 13 Data TypesData TypesList Samples: （1，2，3) （1，2，3,） （） （1 ．．100） （1．7．．5．7） （5 ．．1） （0，2 ．． 6，10，12） （$m ．．$n） （0 ．． $#array） （“fred”, “barney”, “betty”, “wilma”, “dino”） ($rocks[0],$rocks[1],$rocks[2],$rocks[3]) = （“fred”, “barney”, “betty”, “wilma”, “dino”); @ rocks = （“fred”, “barney”, “betty”, “wilma”, “dino”); ($fred, $barney) = ($barney, $fred); @copy = @quarry; $abc=[["00","01"],["10","11"]]; $var=$abc->[1][1]; Subroutines: QW qw(fred barney betty wilma dino) qw ! fred barney betty wilma dino ! qw # fred barney betty wilma dino # qw{ fred barney betty wilma dino } ($rocks[0],$rocks[1],$rocks[2],$rocks[3]) = qw/talc mica feldspar quartz/; @rocks = qw / bedrock slate lava /; ($fred, $barney) = qw ;Data TypesData TypesList Subroutines: pop/push @array = 5..9; $fred = pop(@array); #$fred = 9，@array =（5，6，7，8） $barney = pop @array; #$barney = 8, @array =（5,6,7） pop @array; #@array =（5，6) push(@array,0); #@array = (5,6,0) push @array,8; #@array =（5，6，0，8） push @array,1．．10; #@array @others =qw/9 0 2 1 0 /; push @array,@others; Data TypesData TypesList Subroutines: shift/unshift @array = qw# dino fred barney #; $m = shift (@array); #$m = “dino”, @array = (“fred”, “barney”) $n = shift @array; #$n = ”fred”, @array =（“barney”） shift @array; #@array is empty $o = shift @array; #$o = undef, @array is still empty unshift(@array,5); #@array =（5） unshift @array,4; #@array = (4,5) @others = 1..3; unshift @array, @others; #array =（1,2,3,4,5）Data TypesData TypesList Subroutines: reverse @fred = 6 ．．10; @barney = reverse (@fred); #gets 10，9，8，7，6 sort @rocks = qw/ bedrock slate rubble granite /; @sorted = sort(@rocks); #gets bedrock, granite, rubble, slate @back = reverse sort @rocks; #from slate to bedrock @rocks = sort @rocks; #gets sorted @rocks @numbers = sort 97 ．．102; #gets 100，101，102，97，98，99 sort @rocks; #error, the subroutine must have a return value split $info = “Caine:Micheal:Actor:14,Leafy Drive”; @personal = split(/:/,$info); #@personal = ("Caine", "Michael", "Actor", "14, Leafy Drive");Data TypesData TypesScalar/List Context 42 + something #something must be a scalar sort something #something must be a list @people = qw( fred barney betty ); $number = @people; # $number = 3 @sorted = sort @people; #list context：barney , betty, fred $number = 42 + @people; #scalar context：42+3， $number = 45 @backwards = reverse qw / yabba dabba doo /; #gets doo, dabba, yabba $backwards = reverse qw/ yabba dabba doo /; #gets oodabbadabbay @rocks = qw(talc quartz jade obsidian); print “How many rocks do you have?\n”; print “I have ”, @rocks, “rocks!\n”; #error，outputs the name list of @rocks print “I have ”, scalar @rocks, “rocks!\n”; # outputs the number Data TypesData TypesHash (Key-Value) Samples: %some_hash = (“foo”, 35, “bar”, 12.4, 2.5, “hello”, “wilma”, 1.72e30, “betty”, “bye\n”); $returnvalue = $hash{$some_key}; $family_name{“fred”} = “flintstone”; $family_name{“barney”} = “rubble” foreach $person (qw){ print “I’ve heard of $person $family_name{$person}.\n”; } $foo = “bar”; print $family_name{$foo . “ney”}; #outputs “rubble” @any_array = %some_hash; print “@any_array\n”; # the result maybe: ：betty bye(\n)，wilma 1.72e+30 foo 35 2.5 hello bar 12.4 %new_hash = %old_hash; %ip_address = reverse %host_name;Data TypesData TypesHash (Key-Value) Samples: %last_name = ( “fred” => “flintstone”, “dino” => “smith”, “barney”=> “rubble”; “betty”=> “rubble”, ); Subroutines: keys/values my %hash = (“a”=>1, “b”=>2, “c”=>3); my @k = keys %hash; my @v = values %hash; foreach $person (sort keys %books){ if($books{$person}){ print “$person has $books{$person} items\n” #fred has 3 books } } Data TypesData TypesHash (Key-Value) Subroutines: each while (($key, $value) = each %hash){ print “$key => $value\n”; } exists if(exists $books{$dino}){ print “Hey, there’s a library card for dino!\n”; } delete my $person = “betty”; delete $books{$person}; #remove the library card of $personVariablesVariables3 types of variables: Scalar: $scalar_variable_name List: @list_variable_name Hash: %hash_variable_name VariablesVariables3 types of variables: Scalar: $scalar_variable_name List: @list_variable_name Hash: %hash_variable_name Scope of variables: default: global scope my: private scope local: local scope @list = qw/global scope/; # global scope variable sub mysub { my $str = “This is a private string”; local @list = qw/local scope/; print "@list"."\n"; print $str; } print $str; # error print "@list"; # outputs “global scope” Common Predefined VariablesCommon Predefined Variables<>/ while(<>){ print; } while(){ print; } $_ @list = qw/str1 str2 str3/; @list = qw/str1 str2 str3/; foreach(@list){ foreach $item(@list){ print; print $item; print "\n"; print “\n”; } } $” @arrayName = qw/Tom John Jimmy Charlie/; $" = "|"; print "@arrayName"; # with double quote Common Predefined VariablesCommon Predefined Variables$, @arrayName = qw/Tom John Jimmy Charlie/; $, = "|"; print @arrayName; # without double quote $\ @arrayName = qw/Tom John Jimmy Charlie/; $\ = "\t"; foreach(@list){ print; } $/ Terminator for read data from a file. $0 The name of the running Perl file. $$ The current process ID. $? The latest error status. Common Predefined VariablesCommon Predefined Variables$1、$2、$3、… $_ = "Hello there, neighbor"; if(/(\S+) (\S+), (\S+)/){ print "The words are $1 $2 $3"; } $`、$&、$’ if ("Hello there, neighbor"=~ /\S(\w+),/){ print "That was ($`)($&)($')"; } $-[0] my $target = "abcmnabILOVEcjhabcILOVEiuabILOVEccabc"; my $query = "ILOVE"; my $i = 0; while($target =~ m/$query/g) { printf "Match %d begins at %d\n",++$i, $-[0]; } STDOUT、STDERR @ARGV @INC ConstantsConstantsScalar constant use constant COUNT => 100; # ------------------------------------ print COUNT ; List constant use constant WEEKDAYS => qw( Sunday Monday Tuesday Wednesday Thursday Friday Saturday ); # ------------------------------------------------------------------------ print "Today is ", (WEEKDAYS)[ 1 ], ".\n"; Hash constant use constant WEEKABBR =>{ ‘Monday’ => ‘Mon’, ‘Tuesday’ => ‘Tue’, ‘Wednesday’ =>’Wed’, ‘Thursday’ => ‘Thu’, ‘Friday’ =>’Fri’) # ------------------------------------------------------------------------ %abbr = WEEKABBR; $day = ‘Wednesday’; print “The abbrevaiation for $day is ”, $abbr{$day};ReferenceReferenceScalar reference $numberref = \42; # reference to a scalar value, \ is like & in C $messageref = \”hello ref”; # reference to a string $ra = \$a; # reference to scalar variable $$ra = 2; # dereference:, $ is like * in C List reference $rl = [1,2,3]; # reference to an anonymous list $rl = \@l; # reference to an existing list push (@$rl, "a"); # dereference print $rl->[3] # reference to the fourth member of the list $array = [[1,2,3,4],[5,6,7]]; # matrix $dd = $array->[1][1]; Hash reference %h= {"laurel" => "hardy", "romeo" => "juliet"}; # hash $rh = \%h; # reference to an existing hash $rh = {"laurel" => "hardy", "romeo" => "juliet"}; # reference to an anonymous hash print keys (%$rh); # dereference $x = $rh->{"laurel"}; # dereference @slice = @$rh{"laurel","romeo"}; # slice of a hash ReferenceReferencesubroutine reference $rs = \&foo; # reference to existing subroutine foo $rs = sub {print "foo"}; # reference to anonymous subroutine #(remember the semicolon at the end) &$rs(); # dereference: call the subroutine Control StructuresControl StructuresBranch structures if-else-elsif if (condition1) { doIfSomething(); } elsif (condition2) { doElsifSomething(); } else { doElseSomething(); } unless unless (condition) { doUnlessSomething(); }Control StructuresControl StructuresLoop structures while while (condition) { … } continue { ## clauses after each loop; } for for (pre_clause; end_condition; clause after each loop) { … } pre_clause; while (end_condition) { … } continue { clause after each loop; }Control StructuresControl StructuresLoop structures foreach foreach control variable (@list) { … } until until (condition) { … } while (!condition) { … }Control StructuresControl StructuresLoop structures do … while do { clause; } while (condition); do … until do { clause; } until (condition); {clause;} while (condition) { clause; } {clause;} while (!condition) { clause; } Terseness Terseness if block if (condition1) { if (condition2) { clause; } } condition1 && condition2 && clause; (condition1 and condition2 and claus;) unless block unless (condition1) { unless (condition2) { clause; } } condition1 || condition2 || clause; (condition1 or condition2 or claus;) if-then-else block if (condition1) { … }else { … } express ? if_true_expr : if_false_expr SubroutinesSubroutinesDefinition sub function { … if (condition1) { return ($value1); } … return (\@array1, $value2); } Call ($return1, $return2) = &function(); or ($return1, $return2) = &function; or ($return1, $return2) = function(); or ($return1, $return2) = function;SubroutinesSubroutinesParameters Definition sub function { my ($parameter1, $parameter2, @parameter3)=@_; … } Call &function($value1, $value2, @value3); List Parameters sub function { my (@array1, @array2) = @_; … } # all parameters are assigned to @array1 sub function { my ($parameter1, $parameter2) = @_; my (@array1, @array2); @array1 = @$parameter1; @array2 = @$parameter2; … } # using references of the parameters SubroutinesSubroutinesDynamic call if (condition1) { $function = “function1 $parameter1”; } else { $function = “otherwise”; } eval $function; … sub function1 { my ($parameter1) = @_; … } sub otherwise { … }Regular ExpressionRegular ExpressionCommon Regular Expressions $a="xxx123b5www123f5ssss12375"; $a=~s/123(.*?)5/4/eg; print $a;Regular ExpressionRegular ExpressionPattern-matching modifiers $a="xxx123b4www123f4ssss12374"; $a=~s/123(.*?)4/&getdata($1)/eg; sub getdata { my ($a)=@_; $data .=$a." "; return $data; } print $data;Regular ExpressionRegular ExpressionMulti-match operators Miserliness * 0, 1 or multiple + 1 or multiple ? 0 or 1 {X} = X {X,} >= X {X,Y} >=X and <=Y None miserliness *? 0, 1 or multiple, but as less as possible +? 1 or multiple, but as less as possible ?? 0 or 1 {X}? = X {X,}? >= X, but as less as possible {X,Y} >=X and <=Y, but as less as possibleRegular ExpressionRegular ExpressionSamples 1) my $target = "abcmnabILOVEcjhabcILOVEiuabILOVEccabc"; my $query = "ILOVE"; my $i = 0; while($target =~ m/$query/g) { printf "Match %d begins at %d\n",++$i, $-[0]; } 2) $_ = “The HAL-9000 requires authorization to continue.”; if(/HAL-[0-9]+/){ print “The string mentions some model of HAL computer.\n”; } 3) /fred( +|\t+)barney/Regular ExpressionRegular ExpressionSamples 4) $_ =“green scaly dinosaur”; s/(\w+) (\w+)/$2, $1/; # “scaly, green dinosaur”; s/^/huge, /; # “huge, scaly, green dinosaur” s/,.*een//; #replace with empty,“huge dinosaur” s/green/red/; #failure, “huge dinosaur” s/\w+$/($`!)$& /; # “huge (huge !)dinosaur” s//\s+(!\W+)/$1 /; # “huge (huge!) dinosaur” s/huge/gigantic/; #“gigantic (huge!) dinosaur” 5) $_ = “fred flintstone”; if(s/fred/wilma/){ print “Successfully replaced fred with wilma!\n”; } # s/// return true if it succeed in replacingUsing ModulesUsing ModulesImport Import module path (@INC) Using ModulesUsing ModulesSamples 1) use File:Basename qw/ /; #no subroutines were imported my $name = “/usr/local/bin/perl”; my $dirname = &dirname ($name ); #my own &dirname my $dirname = File::Basename::dirname $name; # call sub in File::Basename module Sub dirname { … } 2) use DBI; my $query="select * from Locate..AccountFtpConfig"; $dbh=DBI->connect("dbi:Sybase:MLOC_DEVL","matrix_admin","matrix_admin123"); $dbh->do("use Locate"); @tables=$dbh->tables(); print "Table list of Locate database:\n"; foreach $tt(@tables) { print "$tt\n"; } my $sth = $dbh->prepare($query); $sth->execute(); #print "Result list:\n"; #print "---------- "; while(my $ref = $sth->fetchrow_arrayref()) { #print "Results: @$ref \n"; #print "---------- "; } $dbh->disconnect();DBI（Database Interface）DBI（Database Interface）DBI Architecture DBI Class Methods DBI Utility Functions DBI Dynamic Attributes Methods Common to All Handles Attributes Common to All Handles Database Handle Methods/Attributes Statement Handle Methods/AttributesDBI（Database Interface）DBI（Database Interface）DBI ArchitectureDBI（Database Interface）DBI（Database Interface）DBI ArchitectureDBI（Database Interface）DBI（Database Interface）DBI Class Methods parse_dsn connect connect_cached available_drivers installed_drivers installed_versions data_sources trace DBI（Database Interface）DBI（Database Interface）DBI Class Methods parse_dsn SYNOPSIS: ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn($dsn) or die "Can't parse DBI DSN '$dsn'"; Example: ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn(“dbi:MyDriver(RaiseError=>1):db=test;port=42"); # The following are the parsed results: # $scheme = 'dbi'; # $driver = 'MyDriver'; # $attr_string = 'RaiseError=>1'; # $attr_hash = { 'RaiseError' => '1' }; # $driver_dsn = 'db=test;port=42'; DBI（Database Interface）DBI（Database Interface）DBI Class Methods connect connect_cached SYNOPSIS: $dbh = DBI->connect($data_source, $username, $password [, \%attr]) or die $DBI::errstr; $dbh = DBI->connect_cached($data_source, $username, $password [, \%attr]) or die $DBI::errstr; $data_source: dbi:DriverName:DSN #data source name, e.g MLOC_DEVL dbi:DriverName:database_name@hostname:port dbi:DriverName:database=database_name;host=hostname;port=port \%attr: {PrintError => 0 or 1, PrintWarn => 0 or 1, RaiseError => 0 or 1, # die with error message AutoCommit => 0 or 1} Example: $dbh = DBI->connect($data_source, $usern, $passw, { PrintError => 0, AutoCommit => 0 }) or die “$DBI::errstr”; $dbh = DBI->connect($data_source, $usern, $passw, { PrintError => 0, RaiseError=>1, AutoCommit => 0 }) ; $dbh = DBI->connect (dbi:DriverName(PrintError => 0, RaiseError=>1):DSN, $usern, $passw) ; $dbh->{RaiseError} = 1; ### disconnect from the database $dbh->disconnect or warn "Disconnection failed: $DBI::errstr\n"; DBI（Database Interface）DBI（Database Interface）DBI Class Methods available_drivers installed_drivers installed_versions data_sources trace SYNOPSIS: #Returns a list of all available drivers by searching for DBD::* modules through the directories in @INC @ary = DBI->available_drivers; #Returns a list of driver name and driver handle pairs for all drivers 'installed' (loaded) into the current process. %drivers = DBI->installed_drivers(); #Calls available_drivers() and attempts to load each of them in turn using install_driver(). DBI->installed_versions; # Print out a formatted list of the installed drivers @ary = DBI->installed_versions; # The list of successfully loaded drivers is returned %hash = DBI->installed_versions; #A hash contains entries for the DBI version, OS name, etc. #Returns a list of data sources (databases) available via the named driver. @ary = DBI->data_sources($driver); #Trace the process, and output information to the console or a file according different tracing level. DBI->trace($level [, trace_log_file]); 0 - Trace disabled. 1 - Trace top-level DBI method calls returning with results or errors. 2 - As above, adding tracing of top-level method entry with parameters. 3 - As above, adding some high-level information from the driver and some internal information from the DBI. 4 - As above, adding more detailed information from the driver. This is the first level to trace all the rows being fetched. 5 to 15 - As above but with more and more internal information. DBI（Database Interface）DBI（Database Interface）DBI Class Methods Example: # Load the DBI module use DBI; #Set trace output to a file at level 1 DBI->trace(1,'trace.log'); # Probe DBI for the installed drivers my @drivers = DBI->available_drivers(); die "No drivers found!\n" unless @drivers; # should never happen #Print out a formatted list of the installed drivers DBI->installed_versions; # Iterate through the drivers and list the data sources for each one foreach my $driver ( @drivers ) { print "Driver: $driver\n"; my @dataSources = DBI->data_sources( $driver ); foreach my $dataSource ( @dataSources ) { print "\tData Source is $dataSource\n"; } } DBI（Database Interface）DBI（Database Interface）DBI Utility Functions data_string_desc($string) #Returns an informal description of the string data_string_diff ($str