plugins/perl/example.pl

   1 use strict;
   2
   3 # Example Perl plugin.
   4 #
   5 # This example can be freely used for any purpose.
   6
   7 # Run it from the build directory like this:
   8 #
   9 #   ./src/nbdkit -f -v ./plugins/perl/.libs/nbdkit-perl-plugin.so  \
  10 #       script=./plugins/perl/example.pl test1=foo test2=bar
  11 #
  12 # Or run it after installing nbdkit like this:
  13 #
  14 #   nbdkit -f -v perl script=./plugins/perl/example.pl test1=foo test2=bar
  15 #
  16 # The -f -v arguments are optional.  They cause the server to stay in
  17 # the foreground and print debugging, which is useful when testing.
  18 #
  19 # You can connect to the server using guestfish or qemu, eg:
  20 #
  21 #   guestfish --format=raw -a nbd://localhost
  22 #   ><fs> run
  23 #   ><fs> part-disk /dev/sda mbr
  24 #   ><fs> mkfs ext2 /dev/sda1
  25 #   ><fs> list-filesystems
  26 #   ><fs> mount /dev/sda1 /
  27 #   ><fs> [etc]
  28
  29 # This is the string used to store the emulated disk (initially all
  30 # zero bytes).  There is one disk per nbdkit instance, so if you
  31 # reconnect to the same server you should see the same disk.  You
  32 # could also put this into the handle, so there would be a fresh disk
  33 # per handle.
  34 my $disk = "\0" x (1024*1024);
  35
  36 # This just prints the extra command line parameters, but real plugins
  37 # should parse them and reject any unknown parameters.
  38 sub config
  39 {
  40     my $key = shift;
  41     my $value = shift;
  42
  43     print "$0: ignored parameter $key=$value\n";
  44 }
  45
  46 sub open
  47 {
  48     my $readonly = shift;
  49
  50     printf ("$0: open: readonly=%d\n", $readonly);
  51
  52     # You can return any Perl value from open, and the same Perl value
  53     # will be passed as the first arg to the other callbacks [in the
  54     # client connected phase].  In most cases it's convenient to use a
  55     # hashref.
  56     my $h = { readonly => $readonly };
  57
  58     return $h;
  59 }
  60
  61 sub get_size
  62 {
  63     my $h = shift;
  64
  65     return length ($disk);
  66 }
  67
  68 sub pread
  69 {
  70     my $h = shift;
  71     my $count = shift;
  72     my $offset = shift;
  73
  74     return substr ($disk, $offset, $count);
  75 }
  76
  77 sub pwrite
  78 {
  79     my $h = shift;
  80     my $buf = shift;
  81     my $count = length ($buf);
  82     my $offset = shift;
  83
  84     substr ($disk, $offset, $count) = $buf;
  85 }