Program Listing

Listing 11-1 contains the complete and uninterrupted code for photo_dumper.pl. You can also find the code on this book’s companion Web site.

Listing 11-1: photo_dumper.pl

start example
01: #!/usr/bin/perl -w 02: use strict; 03: use DBI; 04: my $dbh = DBI->connect ("DBI:mysql:photoalbum","bookuser","testpass")  05:     or die("Cannot connect: $DBI::errstr\n"); 06: my %db; 07: $db{name}  = "photoalbum"; 08: $db{album} = "album_id"; 09: $db{photo} = "img_id"; 10: $db{f_key} = "album_id"; 11: my $main_table = "album"; 12: my @sub_tables = qw{photo}; 13: Gen_Output(); 14: sub Gen_Output { 15:     print qq(<?xml version="1.0"?>); 16:     print start_tag($db{name}), "\n";  17:     my @albums = Get_Keys($main_table); 18:     for my $tmp (@albums) { 19:         print start_tag($main_table), "\n";  20:         Print_Data($main_table, $tmp, 3); 21:         for my $sub_tbl (@sub_tables){ 22:             Do_SubTable($sub_tbl, $tmp);     23:         } 24:         print end_tag($main_table), "\n"; 25:     } 26:     print end_tag($db{name}), "\n";  27: } 28: sub Do_SubTable { 29:     my $table = shift; 30:     my $rel   = shift; 31:     my @keys = Get_Keys($table, $rel); 32:     for my $key (@keys) { 33:         print " ", start_tag($table), "\n"; 34:         Print_Data($table, $key, 4); 35:         print " ", end_tag($table), "\n\n"; 36:     } 37: } 38: sub Get_Keys { 39:     my $table     = shift; 40:     my $index     = shift; 41:     my @values    = (); 42:     my $sql = qq{SELECT $db{$table} FROM $table};  43:     $sql   .= qq{ WHERE $db{f_key} = $index} if($index); 44:     my $sth = $dbh->prepare($sql); 45:     $sth->execute(); 46:     while(my @arr = $sth->fetchrow_array){ push @values, @arr; } 47:     return(@values); 48: } 49: sub Print_Data { 50:     my $table   = shift; 51:     my $key     = shift; 52:     my $indent  = shift; 53:     my @values  = (); 54:     my $sql = qq{SELECT * FROM $table WHERE $db{$table} = ?}; 55:     my $sth = $dbh->prepare($sql); 56:     $sth->execute($key); 57:     while(my $data = $sth->fetchrow_hashref){  58:        for(keys(%$data)){ 59:            $data->{$_} = "" unless defined $data->{$_}; 60:            print " " x $indent, start_tag($_), 61:            xml_esc($data->{$_}), end_tag($_), "\n"; 62:        } 63:     } 64:     return; 65: } 66: sub start_tag { "<"  . xml_esc_name($_[0]) . ">" } 67: sub end_tag   { "</" . xml_esc_name($_[0]) . ">" } 68: sub xml_esc_name { 69:     my $name = shift; 70:     return ‘_’ unless length $name; 71:     $name =~ s/[^-\._a-zA-Z0-9]/_/g; 72:     $name =~ s/^(\d)/_$1/; 73:     return $name; 74: } 75: sub xml_esc { 76:     my $it = shift; 77:     $it =~ s{([^\x20\x21\x23-\x25\x28-\x3b\x3d\x3F-\x5B\x5D-\x7E])} 78:             {‘&#’.(ord($1)).’;’}eg; 79:     return $it; 80: }
end example



Perl Database Programming
Perl Database Programming
ISBN: 0764549561
EAN: 2147483647
Year: 2001
Pages: 175

flylib.com © 2008-2017.
If you may any questions please contact us: flylib@qtcs.net