#!/usr/bin/perl 

use Class::Multimethods; # we will need it!

# $gina is my wife
$gina  = non_eu->citizen;
$mirod = eu->citizen;      

$consul_agent= italian->civil_servant;              # NYC consulate
$nulla_osta= $consul_agent->wants_from( $gina);     # in order to get a visa on order to get a resident permit
                                                    # see way below for more on this

$mirod && $gina->goto( questura);                   # the questura is where the local immigration office is

$nice_lady= italian->civil_servant;                 # very, very helpfull, read on...
$first_attempt= $mirod->asks_for( $nulla_osta);  
printf "a %s? %s\n", ref $nulla_osta, $first_attempt;   # :--(

$nice_lady->thinks;
$suggested= $nice_lady->suggests( resident_permit); # who needs a visa? (every non_eu according to all we've read!)
$second_attempt= $gina->asks_for( $suggested, through => $mirod);
printf "a %s? %s\n", ref $suggested, $second_attempt;     # close...

$boss= italian->civil_servant->boss;                
$boss->decides( $nice_lady->treats( $mirod => quasi_italian)); # quasi_italian inherits from italian!
$third_attempt= $gina->asks_for( $suggested, through => $mirod);
printf "the boss said: a %s? %s\n", ref $suggested, $third_attempt;                    # and there was much rejoicing


# the official rules for getting documents: who can get what
BEGIN
  { multimethod asks_for => (non_eu, nulla_osta)                    => sub { "sure!"               };
    multimethod asks_for => (eu, nulla_osta)                        => sub { "not foreign enough"; };
    multimethod asks_for => (non_eu, resident_permit, '$', non_eu)  => sub { "no way Jose"         };
    multimethod asks_for => (non_eu, resident_permit, '$', italian) => sub { "of course"           };
    resolve_no_match asks_for => sub { "I must ask the boss" };
    # note that (non_eu, resident_permit, '$', eu) is not quite written
  }



package person;
  sub citizen { return bless {}, $_[0] }
  sub goto {};
  sub thinks{ sleep 1; };

package foreigner; use base person;
  use Class::Multimethods asks_for;
package non_eu;    use base foreigner;
package eu;        use base foreigner;
package italian;   use base person;
  sub civil_servant { return italian->citizen; }
  sub suggests      { return $_[1]->new;       }
  sub wants_from    { my $required= document->required;  # logic. But see the code for required...
                      return $required;
                    }
  sub treats        { bless $_[1], $_[2]       }
  sub boss          { return $_[0];            }         # just a normal guy
  sub decides       { }                                  # note the complex processing here
package quasi_italian; use base italian;

package document; 
use Class::CanBeA;
sub new { return bless {}, $_[0] }
sub required
  { my @types = @{Class::CanBeA::subclasses(required_document)};
    my $rand= int( rand scalar @types);                  # the normal algorithm
    my $type= $types[$rand];
    $type= nulla_osta;                                   # the mighty RNG gave us this one
    return $type->new;
  }

package required_document; use base document;
package nulla_osta;        use base required_document;     # note that this one is really, absolutely NOT required 
                                                           # for spouses of eu citizens!
package FBI_clearance;     use base required_document;     # friends of us got this one
package CIA_clearance;     use base required_document;     # then this one!

package resident_permit; use base document;