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
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: }