use DB_File;
tie %persistent, "DB_File", "languages.db" or die $!;
$persistent{"Thank you"} = "arigatou";

# ... gdzie pniej ...

use DB_file;
tie %persistent, "DB_File", "languages.db" or die $!;
print $persistent{"Thank you"} # "arigatou"
---------------------------------
package CD;
use base "Class::Accessor::Assert";
__PACKAGE__->mk-accessors(qw(
   artist=CD::Artist title publishdate=Time::Piece songs=ARRAY
));
---------------------------------
package CD::Song;
use base 'Class::Accessor';
__Package__->mk_accessors("name");

package CD::Person;
use base 'Class::Accesssor::Assert';
__PACKAGE__->mk_accessors(qw(gender haircolor birthdate=Time::Piece));

package CD::Band;
use base 'Class::Accessor::Assert';
__PACKAGE__->mk_accessors( qw(members=ARRAY
                              creationdate=Time::Piece
                              breakupdate=Time::Piece ));

package CD::Artist;
use base 'Class::Accessor::Assert';
__PACKAGE__->mk_accessors(qw( name popularity person band ));

# Jeli to zesp, to przeka skadowe "band"
for my $accessor (qw(members creationdate breakupdate)) {
    *$accessor = sub {
       my $self = shift;
       return $self->band->$accessor(@_) if $self->band
    };
}

# a jeli to osoba, to przeka skadowe "person"
for my $accessor (qw(gender haircolor birthdate)) {
    *$accesssor = sub {
       my $self = shift;
       return $self->person->$accessor(@_) if $self->person
    };
}
---------------------------------
my $tom = CD::Artist->new({ name => "Tom Waits",
                            person => CD::Person->new() });
$tom->popularity(2);
$tom->haircolor("black");

my $cd = CD->new({
   artist => $tom,
   title => "Rain Dogs"
   songs => [ map { CD::Song->new({title => $_}) }
              ("Singapore", "Clap hands", "Cemetary Polka",
               # ...
              ) ]
});
---------------------------------
bless( {
  'title' => 'Rain Dogs'
  'artist' => bless( {
       'popularity' => 2,
           'person' => bless( { 'haircolor' => 'black' }, 'CD::Person' ),
             'name' => 'Tom Waits'
    }, 'CD::Artist' ),
  'songs' => [ 
    bless( { 'title' => 'Singapore'      }, 'CD::Song' ),
    bless( { 'tritle' => 'Clap Hands'    }, 'CD::Song' ),
    bless( { 'title' => 'Cemetary Polka' }, 'CD::Song' ),
    # ...
  ],
}, 'CD' )
---------------------------------
use Data::Dumper; die Dumper($whatever);
---------------------------------
my $dum = { name => "Tweedle-Dum" };
my $dee = { name => "Tweedle-Dee" };
$dee->{brother} = $dum;
$dum->{brother} = $dee;
---------------------------------
$VAR1 = {
          'brother' => {
                          'brother' => $VAR1,
                          'name' => 'Tweedle-Dee'
                        },
          'name' => 'Tweedle-Dum'
        };
---------------------------------
$VAR1 = {
          'brother' => {
                         'brother' => {},
                         'name' => 'Tweedle-Dee'
                       },
          'name' => 'Tweedle-Dum'
        };
$VAR1->{'brother'}{'brother'} = $VAR1;
---------------------------------
open my $out, "> dum.pl" or die $!;
use Data::Dumper;
$Data::Dumper::Purity = 1;
print $out Dumper([ $dee ], [ "dee" ]);
---------------------------------
--- #YAML:1.0 !perl/CD
artist: !perl/CD::Artist
  name: Tom Waits
  person: !perl/CD::Person
    haircolor: black
  popularity: 2
songs:
  - !perl/CD::Song
    title: Singapore
  - !perl?CD::Song
    title: Clap Hands
  - !perl/CD::Song
    title: Cemetery Polka
  ...
title: Rain Dogs
---------------------------------
--- #YAML:1.0 &1
brother:
  brother: *1
  name: Tweedle-Dee
name: Tweedle-Dum
---------------------------------
my $dum = YAML::Load(<<EOF);
--- #YAML:1.0 &1
brother:
  brother: *1
  name: Tweedle-Dee
name: Tweedle-Dum
EOF

print $dum->{brother}{brother}{name}; # Tweedle-Dum
---------------------------------
use Storable;
store $dum, "dum.storable";

# ... pniej ...

my $dum = retrieve("dum.storable");
---------------------------------
$dum = {
          'brother' => {
                         'brother' => $dum,
                         'name' => 'Tweedle-Dee'
                       },
          'name' => 'Tweedle-Dum'
       };
$dee = {
          'brother' => {
                         'brother' => $dee,
                         'name' => 'Tweedle-Dum'
                       }
          'name' => 'Tweedle-Dee'
       };
---------------------------------
$dum = {
         'brother' => (PLEASE RETRIEVE $dee FOR THIS DATA),
         'name' => 'Tweedle-Dum'
       };
$dee = {
         'brother' => (PLEASE RETRIEVE $dum FOR THIS DATA),
         'name' => 'Tweedle-Dee'
       };
---------------------------------
use Compress::Zlib;

$db = tie %hash, "DB_File", "music.db" or die $!;
$db->filter_store_value(sub { $_ = compress($_)   });
$db->filter_fetch_value(sub { $_ = uncompress($_) });
---------------------------------
$db->filter_fetch_key   ( sub { s/\0$//   } ) ;
$db->filter_store_key   (sub { $_ .= "\0" } ) ;
$db->filter_fetch_value( sub { s/\0$//    } ) ;
$db->filter_store_value( sub { $_ .= "\0" } ) ;
---------------------------------
use Storable qw(freeze thaw);
$db->filter_store_value( sub { $_ = freeze($_) } );
$db->filter_fetch_value( sub { $_ = thaw($_)   };
---------------------------------
use MLDBM qw(DB_File Storable); # Skorzystaj ze Sleepycat DB i Storable

tie %hash, "MLDBM", "music.db" or die $!;

my $tom = CD::Artist->new({ name => "Tom Waits",
                          person => CD::Person->new() });
$martyn->popularity(1);

$hash{"album1"} = CD->new({
      artist => $tom,
      title  => "Rain Dogs",
      tracks => [ map {CD::Song->new({title => $_}) }
                  ("Singapore", "Clap Hands", "Cemetery Polka", ...)
                ]
});
---------------------------------
use MLDBM qw(DB_File Storable); # Skorzystaj ze Sleepycat DB i Storable
tie %hash, "MLDBM", "hash.db" or die $!;
$hash{test} = { "Hello" => "World" };
---------------------------------
$hash{test}->{Hello} = "Mother";
---------------------------------
$hash{test} = { %{$hash{test}}, Hello => "Mother" };
---------------------------------
use Pixie::Store::DBI;
Pixie::Store::DBI->deploy("dbi:mysql:dbname=pixie");
---------------------------------
my $cd = CD->new({
   artist => $tom,
   title => "Rain Dogs"
   songs => [ map { CD::Song->new({title => $_}) }
              ("Singapore", "Clap Hands", "Cemetery Polka",
               # ...
               ) ]
}); 

my $pixie = Piexie->new->connect("dbi:mysql:dbname=piexie");
my $cookie = $pixie->insert($cd);
---------------------------------
use Pixie;
use CD;
my $pixie = Pixie->new->connect("dbi:mysql:dbname=pixie")
my $cd = $pixie->get("EAAC3A08-F6AA-11D8-96D6-8C22451C8AE2");

print $cd->artist->name; # "Tom Waits"
---------------------------------
$VAR1 = bless( {
                 'tz' => bless( {
                                  'name' => 'UTC'
                                }, 'DateTime::TimeZone::UTC' ),
                 'local_c' => {
                                'quarter' => 3,
                                'minute' => 13,
                                'day_of_week' => 7,
                                'day' => 19,
                                'day_of_quarter' => 81,
                                'month' => 9,
                                'year' => 2004,
                                'hour' => 13,
                                'second' => 3,
                                'day_of_year' => 263,
                               },
                  ...,

               }, 'DateTime' );
---------------------------------
sub DateTime::px_freeze {
    my $datatime = shift;
    bless [ $datetime->epoch ], "Proxy::DateTime";
}
---------------------------------
sub Proxy::DateTime::px_thaw {
    my $proxy = shift;
    DateTime->from_epoch(epoch => $proxy->[0]);
}
---------------------------------
sub MyModule::px_is_storable { 1 }
---------------------------------
use Tangram;
use Tangram::TimePiece;
use DBI;
use CD;
our $schema = Tangram::Relational->schema({
    classes => [
        CD => {
            fields => {
                string => [ qw(title) ],
                timepiece => [ qw(publishdate) ],
                iarray => {
                   songs => {
                       class => 'CD::Song',
                       aggreg => 1,
                       back => 'cd',
                   },
                },
            },
        },
'CD::Song'=> {
    fields => {
        string => [ qw(name) ],
    }
},
'CD::Artist' => {
    abstract => 1,
    fields => {
        string => [qw(name popularity) ],
        iset => {
            cds => {
                class => 'CD',
                aggreg => 1,
                back => 'artist'
            },
        },
    },
},
'CD::Person' => {
    bases => [ "CD::Artist" ],
    fields => {
        string => [qw(gender haircolor) ],
        timepiece => [ qw(birthdate) ],
    },
},
'CD::Band' => {
    bases => [ "CD::Artist" ],
    fields => {
        timepiece => [ qw(creationdate enddate) ],
        set => {
            memebers => {
                 class => 'CD::Person',
                 table => "artistgroup",
            },
        },
    },
},
]});
   $dbh = DBI->connect{$data_source,$user,$password);
   Tangram::Relational->deploy($schema, $dbh);
   $dbh->disconnect();
---------------------------------
my ($cd, @songs, $band, @people);
my $tom = CD::Band->new
    ({ name => "Tom Waits",
      popularity => "1",
      cds => Set::Object->new
      (
       $cd =
       CD->new({title => "Rain Dogs",
               songs => [
             @songs = map {CD::Song->new({new({name => $_ })}
             "Singapore", "Clap Hands", "Cemetery Polka", ...
                        ],
             }),
      ),
});

# podczenie
my $storage = Tangram::Storage->connect($schema, $data_source, $username, $password);
my $oid = $storage->insert($tom);
my $id => $storage->export_object($tom)
---------------------------------
# ID obiektu
$band = storage->load($oid);

# Klasa i ID - wybr polimorficzny
$band = $storage->import_object("CD::Artist", $id);
---------------------------------
my $r_artist = $storage->remote("CD::Artist");

my @artists = $storage->select
    ( $r_artist,
      $artist->{name} eq "Tom Waits" );
my $r_cd = $storage->remote("CD");
---------------------------------
my $join = ($r_cd->{artist} eq $r_artist);
my $query = 
    ( $r-artist->{name}->upper()->like(uc("%beat%"))
      | $r_cd->{title}->upper()->like(uc("%beat%")) );

my $filter = $join & query;
my $cursor = $storage->cursor ( $r_cd, $filter );

my @cds=();
while ( my $cd = $cursor->current ) {
    print("odszukana pyta = " ,$cd->title,
          ", wykonawca = ", $cd->artist->name, "\n");
    $cursor->next;
}
---------------------------------
@cds = $artists[0]->cds->members; # Set::Object
my @tracks = @{ $cds->[0]->songs }; # Array
---------------------------------
my ($pfloyd) = $storage->select
    ( $r_artist,
      $r_artist->{name} eq "Pink Floyd" );

$cd;
$pfloyd->cds->insert
    ($cd=
CD->new({ title => "The Dark Side of The Moon",
          publishdate => Time::Piece- strptime("2000-04-06", "%y-%m-%d"),
          songs => [ map { CD::Song->new({ name => $_}) }
                     "Speak To Me/Breathe", "On The Run",
                   "Time", "The Great Gig in the Sky",
                     "Money", "Us And Them",
                     "Any Colour You Like", "Brain Damage",
                   "Eclipse",
                  ], 
          })
);
$pfloyd->popularity("legendary");
$storage->update($pfloyd);
$storage->id($cd);
---------------------------------
my (@gonners) = $storage->select
    ($r_artist,
     $r_artist->{popularity} eq "one hit wonder");

$storage->erase(@gonners);
---------------------------------
use DBI;
my $dbh = DBI->connect("dbi:SQLite:dbname=music.db");
$dbh->do("CREATE TABLE cds ( ... )");
---------------------------------
package CD::DBI;
our $dbh = DBI->connect("dbd:mysql:music");

sub select {
    my ($class, $sql, @params) = @_;
    my $sth = $dbh->prepare($sql);
    $sth->execute(@params);
    my @objects;
    while (my $obj = $sth->fetchrow_hashref()) {
        push @objects, (bless $obj, $class);
    }
}

package CD;
use base 'CD::DBI';

package CD::Artist;
use base 'CD::DBI';
#...

package main;

my #cds = CD->select("SELECT * FROM cd");
---------------------------------
{
    id => 180,
    title => "Inside Out",
    artist=> 105,
    publishdate => "1983-03-14"
}
---------------------------------
package CD;
sub artist {
    my $self = shift;
    my ($artist) = CD::Artist->select
        "SELECT * FROM artist WHERE id = ?",
        shift->{artist}
    );
    return $artist;
}
---------------------------------
sub tracks {
    my $self = shift;
    CD::Track->select("SELECT * FROM track WHERE cd = ?",
                      $self->{id}
                      );
}
---------------------------------
package CD;
sub title {
    my ($self, $title) = @_;
    if ($title) {
        $CD::DBI::dbh->do("UPDATE cd SET title = ? WHERE id = ?",
                          undef, $title, $self->{id});
    }
    $self->SUPER::title($title);
}
---------------------------------
package CD::DBI;
use base 'Class::DBI';
__PACKAGE__->connection("dbi:mysql:musicdb");
---------------------------------
package CD::Artist;
use base 'CD::DBI';
__PACKAGE__->table("artist");
__PACKAGE__->columns(All => qw/artistid name popularity/);
---------------------------------
my $waits = CD::Artist->search(name => "Tom Waits")->first;
print $waits->artistid; # 859
print $waits->popularity; # 634

my $previous = CD::Artist->retrieve(858);
print $previuos->name; # Tom Petty and the Heartbreakers

# A wic ilu tam mamy Tomw?
my $toms = CD::Artist->search_like(name => "Tom %")->count;
print $toms; # 6

for my $artist ( CD::Artist->retrieve_all ) {
    print $artist->name, ": ", $artist->popularity, "\n";
}
---------------------------------
$buff = CD::Artist->create({
    name => "Buffalo Springfield";
    popularity => 10
});
---------------------------------
use Mac::AppleScript qw(RunAppleScript;
my $current = RunAppleScript(<<AS);
  tell application "iTunes"
    artist of current track
  end tell
AS

my $artist = CD::Artist->find_or_create({ name => $current });
$artist->popularity( $artist->popularity() + 1 );
$artist->update;
---------------------------------
package CD::Artist
use base 'MusicDB::DBI';
__PACKAGE__->table("artist");
__PACKAGE__->columns(All => qw/artistid name popularity/);
__PACKAGE__-> autoupdate(1);
---------------------------------
package CD::DBI;
use base 'Class::DBI::mysql';
__PACKAGE__->connection("dbi:mysql:musicdb");
__PACKAGE__->autoupdate(1);

package CD::Artist;
use base 'CD::DBI';
__PACKAGE__->set_up_table("artist");
---------------------------------
CD->has_a(artist => "CD::Artist");
CD::Track->has_a(song => "CD::SONG");
# ...
---------------------------------
CD->has_a(publishdate => 'Time::Piece',
              inflate => sub { Time::Piece->strptime(shift, "%Y-%m-%d") },
              deflate => 'ymd',
          );
---------------------------------
CD->has_many(tracks => "CD::Track");
---------------------------------
for my $cd (CD->retrieve_all) {
    print "CD: ".$cd->title."\n";
    print "Artysta: ".$cd->artist->name."\n"
    for my $track ($cd->tracks) {
        print "\t".$track->song->name."\n";
    }
    print "\n\n";
}
---------------------------------
use Class::DBI::Relationship::IsA;
CD::Artist->is_a(person       => 'CD::Person');
CD::Artist->is_a(artistgroup  => 'CD::Artistgroup');
---------------------------------
my $loader = Class::DBI::Loader->new(
    dsn => "dbd:mysql:music",
    namespace => "MusicDB"
);
---------------------------------
$loader->relationship("a cd has an artist");
$loader->relationship("a cd has tracks");
# ...
---------------------------------
use CD;
use CGI qw/:standard/;
use Template;
print header();
my $id = param("id");
if (!$id) {
    print "<h1> Musisz poda identyfikator! </h1>; exit;
}
my $obj = CD->retrieve($id);
Template->new()->process("view.tt, { cd => $obj });
---------------------------------
<html>
   <head> <title>[%%cd.name %]</title> </head>
<body>
   <h1> [% cd.name %] </h1>
   <h2> [% cd.name %] </h2>

<ul>
[% FOR track = cd.tracks %]
    <li> [% track.song.name %] </li>
[% END %]
</ul>
</body>
</html>
---------------------------------
use CD;
package CD;
use Class::DBI::Pager;

package main;
use CGI qw/:standard/;
use Template;
print header();
use constant ITEMS_PER_PAGE => 20;

my $page = param("page") || 1;
my $pager = CD->page(ITEMS_PER_PAGE, $page);
my @cds = $pager->retrieve_all;
Template->new()->process("view.tt", { cds => \@cds, pager => $pager });
---------------------------------
 [% IF pager.previous_page %]
<A HREF="?page=[%pager.previous_page%]"> Poprzednia strona </A>
[% END %]
Page [% pager.current_page %]
[% IF pager.next_page %]
| <A HREF="?page=[%pager.next_page%]"> Nastpna strona </A>
[% END %]
---------------------------------
package CDPole;
use base 'Maypole::Application';
use CD;
CDPole->config->model("Maypole::Model::CDBI::Plain");
CDPole->setup([qw/ CD CD::Artist CD::Track /]);
CDPole->config->uri_base("http://localhost/cdpole/");
CDPole->config->template_root("/home/simon/modules/Apache-MVC/templates/");
1;
---------------------------------
package CD::Artist;

sub all_tracks :Exported {
    my ($self, $r, $artist) = @_;
    $r->template_args->{tracks} = [ map { $_->tracks } $artist->cds ]
}
---------------------------------
 [% PROCESS macros %]
[% INCLUDE header %]
<h2> All tracks for [% artist.name %] </h2>

<ul>
[% FOR track = tracks %]
<li> [% maybe_link_view(track) %] </li>
[% END %]
</ul>
[% INCLUDE footer %]
